Thursday, May 10, 2007

Perl Script to Login to Orkut

Finally
Succeeded in making the Perl Script that logs you into Orkut! Signing into Orkut is much more than a simple POST, Google is always clever so that they make things complex for automating the login process. Anyway here is the complex script, ..

Algorithm


  1. Goto www.orkut.com

  2. Check whether the title is Home.

  3. If not find the source of login page IFRAME

  4. Fill the username and password and submit the FORM.

  5. Find the follow link from the next page.

  6. Goto the followlink and GET the redirect page URL

  7. Goto the redirect page

  8. Goto Orkut.com/home.aspx

  9. Your done.



Note:
Tested on Linux (FC6, Perl 5.8.8)
The following script is for linux, Will run on Windows too but the ANSI coloring may not work...
Windows Program is given below the program for Linux (without ANSI coloring).
For Linux (with ANSI coloring)

use WWW::Mechanize;
use HTTP::Cookies;
use HTTP::Request::Common;

$cj=HTTP::Cookies->new(file => "cookie.jar",autosave=>1,ignore_discard=>1);
$mech = WWW::Mechanize->new(cookie_jar => $cj);

@prc = ("\e[0m\n","[\e[1;31mFAILED\e[0m]","[\e[2;32m OK \e[0m]\n");

print "\n\e[31;1mG\e[0mmail iD : ";
$email = ;
print "\e[31;1mP\e[0massword : \e[97m";
$pass = ;
print $prc[0];

chomp $email;chomp $pass;

RELOGIN:
for($i=3; $i>=0;$i--)
{
printf("\e[2m%-60s","GET /Home.aspx");
$mech->get("http://www.orkut.com/Home.aspx");
last if($mech->success());

printf("%10s",$prc[1]);
print "\e[2;37m Retry (",$i,")".$prc[0] if($i);
}

return if($i<=0);
print $prc[2];


$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

if($mech->title =~ m/orkut.*home/i)
{
print "\n\e[34mAlready Logged In",$prc[0];

$cnt =~ m/<b>(.*)\@gmail.com<\/b>/;

print "\nLogout $1?[n] : ";
$com=;chomp $com;
if($com eq "y")
{
logout;
goto RELOGIN;
}
else
{
return;
}
}

$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

printf("\e[2m%-60.59s","Parsing for Login Page ");
#print $cnts;
if($cnt !~ m/id='liframe'.*?src='(.*)'/)
{
printf("%10s",$prc[1]);
print "\e[2;37m Login page URL Not Found!\nTry Again OR Update the script! ".$prc[0];

return;
}

print $prc[2];
$url = $1;
$j=3;
REDO:
for($i=3;$i>=0;$i--)
{
printf("\e[2m%-60.59s","GET $url");
$mech->get($url);
last if($mech->success());

printf("%10s",$prc[1]);
print "\e[2;37m Retry (",$i,")".$prc[0] if($i);
}

return if($i<=0);

print $prc[2];

$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

$mech->form_number(1);
$mech->field("Email",$email."\@gmail.com");
$mech->field("Passwd",$pass);


printf("\e[2m%-60.59s","Logging In ... ");

$mech->click("null");

$j--;
if($j && !$mech->success())
{
printf("%10s\n",$prc[1]);
goto REDO;
}
return unless($j);

$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

if(!$mech->find_link(text => "click here to continue"))
{
printf("%10s",$prc[1]);
print "\n\e[31;1mWrong Usename or Password!",$prc[0];
return;
}


print $prc[2];
for($i=3;$i>=0;$i--)
{
printf("\e[2m%-60.59s","Continuing ...");
$mech->follow_link(text => "click here to continue");
last if($mech->success());

printf("%10s",$prc[1]);
print "\e[2;37m Retry (",$i,")".$prc[0] if($i);
}

return if($i<=0);

print $prc[2];

printf("\e[2m%-60s","Parsing REDIRECT URL");
$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

if($cnt !~ m/location.replace\("(.*)"\)/)
{
printf("%10s",$prc[1]);
print "\n\e[31;1mRedirect script missing!",$prc[0];
return;
}

$url = $1;
$url =~ s/\\u003d/=/g;

print $prc[2];
for($i=3;$i>=0;$i--)
{
printf("\e[2m%-60.59s","GET $url");
$mech->get($url);
last if($mech->success());

printf("%10s",$prc[1]);
print "\e[2;37m Retry (",$i,")".$prc[0] if($i);
}
return if($i<=0);

print $prc[2];
print "\e[34mLogged In!\e[0m";
exit 0;


sub logout
{

printf("\e[0;2m%-60s","Parsing Logout");
if(!$mech->find_link(text => "Logout"))
{
printf("%10s",$prc[1]);
print "\n\e[31;1mNot Logged In?",$prc[0];
return;
}


print $prc[2];
for($i=3;$i>=0;$i--)
{
printf("\e[2m%-60.59s","Logging Out ...");
$mech->follow_link(text => "Logout");
last if($mech->success());

printf("%10s",$prc[1]);
print "\e[2;37m Retry (",$i,")".$prc[0] if($i);
}
return if($i<=0);

print $prc[2];
}


For windows:

use WWW::Mechanize;
use HTTP::Cookies;
use HTTP::Request::Common;

$cj=HTTP::Cookies->new(file => "cookie.jar",autosave=>1,ignore_discard=>1);
$mech = WWW::Mechanize->new(cookie_jar => $cj);

@prc = ("\n","[FAILED]","[ OK ]\n");

print "\nEmail iD : ";
$email = ;
print "Password : \e[97m";
$pass = ;
print $prc[0];

chomp $email;chomp $pass;

RELOGIN:
for($i=3; $i>=0;$i--)
{
printf("%-60s","GET /Home.aspx");
$mech->get("http://www.orkut.com/Home.aspx");
last if($mech->success());

printf("%10s",$prc[1]);
print " Retry (",$i,")".$prc[0] if($i);
}

return if($i<=0);
print $prc[2];


$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

if($mech->title =~ m/orkut.*home/i)
{
print "\nAlready Logged In",$prc[0];

$cnt =~ m/<b>(.*)\@gmail.com<\/b>/;

print "\nLogout $1?[n] : ";
$com=;chomp $com;
if($com eq "y")
{
logout;
goto RELOGIN;
}
else
{
return;
}
}

$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

printf("%-60.59s","Parsing for Login Page ");
#print $cnts;
if($cnt !~ m/id='liframe'.*?src='(.*)'/)
{
printf("%10s",$prc[1]);
print "Login page URL Not Found!\nTry Again OR Update the script! ".$prc[0];

return;
}

print $prc[2];
$url = $1;
$j=3;
REDO:
for($i=3;$i>=0;$i--)
{
printf("%-60.59s","GET $url");
$mech->get($url);
last if($mech->success());

printf("%10s",$prc[1]);
print " Retry (",$i,")".$prc[0] if($i);
}

return if($i<=0);

print $prc[2];

$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

$mech->form_number(1);
$mech->field("Email",$email."\@gmail.com");
$mech->field("Passwd",$pass);


printf("%-60.59s","Logging In ... ");

$mech->click("null");

$j--;
if($j && !$mech->success())
{
printf("%10s\n",$prc[1]);
goto REDO;
}
return unless($j);

$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

if(!$mech->find_link(text => "click here to continue"))
{
printf("%10s",$prc[1]);
print "\nWrong Usename or Password!",$prc[0];
return;
}


print $prc[2];
for($i=3;$i>=0;$i--)
{
printf("%-60.59s","Continuing ...");
$mech->follow_link(text => "click here to continue");
last if($mech->success());

printf("%10s",$prc[1]);
print "Retry (",$i,")".$prc[0] if($i);
}

return if($i<=0);

print $prc[2];

printf("%-60s","Parsing REDIRECT URL");
$cnt = $mech->response->as_string;
$cnt =~ s/\n|\s+/ /g;

if($cnt !~ m/location.replace\("(.*)"\)/)
{
printf("%10s",$prc[1]);
print "\nRedirect script missing!",$prc[0];
return;
}

$url = $1;
$url =~ s/\\u003d/=/g;

print $prc[2];
for($i=3;$i>=0;$i--)
{
printf("%-60.59s","GET $url");
$mech->get($url);
last if($mech->success());

printf("%10s",$prc[1]);
print " Retry (",$i,")".$prc[0] if($i);
}
return if($i<=0);

print $prc[2];
print "Logged In!";
exit 0;


sub logout
{

printf("%-60s","Parsing Logout");
if(!$mech->find_link(text => "Logout"))
{
printf("%10s",$prc[1]);
print "\nNot Logged In?",$prc[0];
return;
}


print $prc[2];
for($i=3;$i>=0;$i--)
{
printf("%-60.59s","Logging Out ...");
$mech->follow_link(text => "Logout");
last if($mech->success());

printf("%10s",$prc[1]);
print "\e[2;37m Retry (",$i,")".$prc[0] if($i);
}
return if($i<=0);

print $prc[2];
}




Libs needed
LWP;
WWW::Mechanize;

Description
Script that logs you into orkut, It has its own Fail-retry methods and all the action is presented neatly in the terminal, using color codes (ANSI Escape sequences for LINUX)
There is more of this script currently in the beta version, for mass scrapping etc. For more information about the beta codes, leave your email as a comment.

Bugs ?
Please do let me know the bugs , so that i can update the script here...
It works for me... Did it work for you? Let me know... (else I may think this is all crap!)

Happy Automating,.. :)

25 comments:

Anonymous said...

redhidus@yahoo.com

Pisharody(U know me!) said...

Simply wonderful. I knew you were PERLing from your "first Perl" post and agin I knew you were playing with orkut when I saw your scrap....

Pisharody(U know me!) said...

Wonderful Work... Proud of you!!

Raju Sykam said...

is that working for you? I am trying to get it worked for last 3 hrs.

I am already having LWP ,and WWW:Mechanize. I checked multi times,and I am continuosly falling into so many errors.

but anyhow, thats a great start from you.

Dont forget that Orkut asks for ' Image verifiaction' to avoid bots and mass scrapping.

Arun Prabhakar said...

can u copy paste the errors ?

Raju Sykam said...

I copied all your code and
changed the following:

$email = ; to $email="my_orkut_id";

$pass = ; to $pass="my_orkut_passwd";

and

$com=;chomp $com;
to $com=""; chomp $com;

and tested from commmand prompt:
c:\usr>perl orkut/o.pl

output is:

Misplaced _ in number at C:/usr/lib/WWW/Mechanize.pm line 201.

←[31;1mG←[0mmail iD : ←[31;1mP←[0massword : ←[97m←[0m
←[2mGET /Home.aspx [←[2;32m OK ←[0m]
←[2mParsing for Login Page [←[2;32m OK ←[0m]
←[2mGET https://www.google.com/accounts/ServiceLoginBox?service [←[1;31mFAILED←[0m]←[2;37m Retry (3)←[0m
←[2mGET https://www.google.com/accounts/ServiceLoginBox?service [←[1;31mFAILED←[0m]←[2;37m Retry (2)←[0m
←[2mGET https://www.google.com/accounts/ServiceLoginBox?service [←[1;31mFAILED←[0m]←[2;37m Retry (1)←[0m
←[2mGET https://www.google.com/accounts/ServiceLoginBox?service [←[1;31mFAILED←[0m]Can't return outside a subroutine at orkut/o.pl
line 82.

and tested from perl builder:
output is:


.[31;1mG.[0mmail iD : .[31;1mP.[0massword : .[97m.[0m
.[2mGET /Home.aspx [.[1;31mFAILED.[0m].[2;37m Retry (3).[0m
.[2mGET /Home.aspx [.[1;31mFAILED.[0m].[2;37m Retry (2).[0m
.[2mGET /Home.aspx [.[1;31mFAILED.[0m].[2;37m Retry (1).[0m
.[2mGET /Home.aspx [.[1;31mFAILED.[0m]

Raju Sykam said...

I am good @ PHP and new to Perl. 3 days back, one php class was released to grab the contacts of orkut account by automating the login by cURL. Unfortunately, that does not work for me and I am trying to debug it for last 3 days. Today, I am sitting to do the same in Perl and found yours script. Hope you can help me.
Is this perl script working for you.?

Raju Sykam said...

I think you are good at PHP also. so as I said before, "contactgrabber from orkut" in PHP is @ http://sourceforge.net/projects/contactgrabber
Hope It can help us.

Anonymous said...

the error is in C:/usr/lib/WWW/Mechanize.pm

try reinstalling it
or updating....

Arun Prabhakar said...

This is working for me very well...
I am also able to scrap after logging in..

Raju Sykam said...

Can u tell me what versions u r using.
I am using ActivePerl 5.8.8 build 820
and WWW::Mechanize version 1.2 on windows xp sp2

Arun Prabhakar said...

Perl 5.8.8
WWW::Mechanize 1.22
Fedora Core 6

smart said...

Its good work...

sujit said...

Arun, its good work. I am able to log in. Is it possible to scrap using your script afterlogging in? Thanks in advance

Arun Prabhakar said...

NO the scrapping script is nt included with this ....

Orkut recently changed its codes ....
so a new script needs to be written to scrap....

Sarath said...

Great work man.
How do u get time to do all these?

Anonymous said...

Great work, but the redirection does not appear to work. After following the 'click to continue' link I get back to the login page.

raja said...

It really Rocks!!

Sandeep said...

I have successfully used the code for logging in the orkut and then displaying the whole profile page i.e. html code as string and then storing it in a single variable and displaying it. Can you please help me out to extract the required data from the profile page such as name, friends from the friends list, etc and store it in database eg MySql

Arun Prabhakar said...

Use the DBI Module in Perl to connect to MySQL, Get the required information by parsing the appropriate web pages.

Sandeep said...

I am facing difficulty in parsing the data and then storing it in the database. The problem is that i have to search for the (my) profile link on the home page and then get the access or get through it and get the source code to parse and store the data like no of scraps, fans, testimonials, and then get through the my friends and get into the any friends profile and then do the same thing that is get and store the data in database .....
Can u help me out.....

Arun Prabhakar said...

May be you can see my post with the perl script for scrapping and does some GET requests and parsing, you can use it as a base to make your program.

Anonymous said...

I tried to use it but it seems that is not working anymore.

Thanks

Anonymous said...

I tried to loging to my orkut account by strawberry perl This is 0.1.2, corresponding to Strawberry Perl 5.8.8 Alpha 2. I could not login as it fails to login after trying thrice!! what may be the problem?

Pablo Santa said...

Hi Arun,

Great work. Is this script still working as of today?

Thanks.