Showing posts with label Perl. Show all posts
Showing posts with label Perl. Show all posts

Friday, January 09, 2009

set facebook user status

If you are familiar with facebook (or for that matter, any one of the gazillion social networking applications out there), there is a way for a user to set his status - any random string. Just like one can set a custom message on his favorite IM client.

One of my friend was exploring the facebook REST api's and was trying to set the status via the REST api. Now facebook has a peculiar feature where for certain functionality, the service adds additional security and needs additional permissions. Now, setting of the status is one such api that needs additional permission. And my friend was finding it hard to figure out how to get the permission using the REST apis. There are means to get the permission if you develop for/on the facebook platform. I too did take a look at the perl facebook api module but got fed up.

Then I googled and found this link. I used the code and ran the script. I was able to login but could not set the status nor fetch the status. So I spent some time hacking around and looking at the response from the facebook and updated the script. Now the script works, one can set the status and get the current status as well. Remember, this is not using the REST apis or the web service. I guess this is called as data scraping or spoofing? I am not sure. The code/script is not optimized but ...

Anyway, here is the perl code. The script takes the facebook login email, pass and status string as the argument...


#!/usr/bin/perl -w
use strict;
use warnings;
use HTTP::Cookies;
use LWP::UserAgent;

my $email;
my $password;

my $user_agent = 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.6) Gecko/20060728 Firefox/1.5.0.6'; # whatever...

#print "Please enter FB email for login\n";
$email = $ARGV[0]; #read the login e-mail
#print "Please enter FB password\n";
$password= $ARGV[1]; #read the password

print "Thanks\n";

chomp($email); #remove last line
chomp($password);

my %postLoginData; #necessary post data for login
$postLoginData{'email'}=$email;
$postLoginData{'pass'}=$password;
$postLoginData{'persistent'}=1;
$postLoginData{'login'}='Login';

our $response; #holds the response the HTTP requests
#set the headers, let's make this a Firefox browser!
my @header = ('Referer'=>'http://www.facebook.com', 'User-Agent'=>$user_agent);

our $cookie_jar = HTTP::Cookies->new(file=>'fbkCookies.dat',autosave=>1, ignore_discard=>1);

our $browser = LWP::UserAgent->new; #init browser
$browser->cookie_jar($cookie_jar);

# incase you are behind a proxy
# $browser->proxy(['http', 'https'], 'http://127.0.0.1:9876/');

$browser->get('http://www.facebook.com/login.php',@header);

#here we actually login!
$response = $browser->post('https://login.facebook.com/login.php',\%postLoginData,@header);

#was login successful?
if($response->content =~ /Incorrect Email/) {
print "Login Failed...Quitting..\n";
}
else {
print "..and we are in!\n";
#let's go to the homepage
$response = $browser->get('http://www.facebook.com/home.php',@header);

$response->content =~ /

Tuesday, December 02, 2008

sipping with Net::SIP

As I had indicated in my earlier post, Net::SIP module for perl really streamlines a lot of the things for quick testing and automation. Net::SIP provides the SIP framework using which one can develop any of the SIP entity functionalities like Registrar, Proxy, UA, etc.

Net::SIP has a lot more associated modules, that help whip up some specific SIP entities in a couple of hours. Like for eg: Net::SIP::Registrar helps to implement a fully working registrar functionality fairly quickly. There are many such modules to help you build many of these entities.

The following is a sample code that acts as a SIP UA that registers with a registrar and makes a call using the Net::SIP::Simple module (from the module example) complete with SDP and RTP packet handling.

use Net::SIP;

# create new agent
my $ua = Net::SIP::Simple->new(
outgoing_proxy => '192.168.0.10',
registrar => '192.168.0.10',
domain => 'example.com',
from => 'me',
auth => [ 'me','secret' ],
);

# Register agent
$ua->register;

# Invite other party, send anncouncement once connected
$ua->invite( 'you',
init_media => $ua->rtp( 'send_recv', 'announcement.pcmu-8000' ),
asymetric_rtp => 1,
);

# Mainloop
$ua->loop;
Isn't that simple? If one has some custom requirements, then Net::SIP provides low level modules and utilities using which one can implement custom SIP entities and behaviours.  Net::SIP::Packet lets you handle the SIP packets and Net::SIP::Leg which acts as a wrapper around sockets and lets one send and receive data.

happy sipping....


Monday, November 10, 2008

SIP and Perl

I have been working with SIP(Session Initiation Protocol) and VoIP in general on and off for many years now. And I have been using perl whenever I could to automate stuff like testing, generate testcases, during performance testing and for recreating scenarios and fixing issues that occur at interops or at remote sites by analyzing the logs.

And uptill now, I had used some very primitive level coding involving string manipulation, sockets and some quick and dirty hard coded stuff in the code to achieve the required functionality asap. I loved this approach because it gave me immense power to simulate any scenario and simulate any proprietary implementations of vendors.

Here is a sample crude perl code I used to use earlier for simulating a SIP UA. Of course on the other end would be a SIP UA we are testing, or some other entity under test. This SIP UA registers with a registrar and waits for an incoming call and establish a call/session. Don't even ask me why this script waits for 2 responses for REGISTER, I don't even remember.


#!/usr/bin/perl -w
use IO::Socket;

#--------------------------------------------------------

$numArgs = $#ARGV + 1;
print "thanks, you gave me $numArgs command-line arguments.\n";

#-------------------------------------------------------

my $sock = new IO::Socket::INET (
LocalPort => 8888,
PeerAddr => '10.232.14.112',
PeerPort => '5060',
Proto => 'udp',
);
die "Could not create socket: $!\n" unless $sock;

#-------------------------------------------------------

my $sip_request="";
my $response = "";

# register
$sip_request = "REGISTER sip:10.232.14.112:5060 SIP/2.0\r\nFrom: 1550 ;tag=hrs7fes6\r\n";
$sip_request = $sip_request."To: 1550 \r\nCall-ID: ft36633sdffff7a21111111z7\r\n";
$sip_request = $sip_request."CSeq: 1 REGISTER\r\nContact: 1550 ;q=0.9;expires=3600\r\n";
$sip_request = $sip_request."Via: SIP/2.0/UDP 10.232.15.31:8888;branch=z9hG4bK548s97i77d555458fs\r\n";
$sip_request = $sip_request."Max-Forwards: 70\r\n\r\n";

print "Request to be sent: \n$sip_request\n";

print $sock $sip_request;
#
$sock->recv($sip_request, 5000);
print "Response received: \n$sip_request\n";

$sock->recv($sip_request, 5000);
print "Response received: \n$sip_request\n";

#-------------------------------------------------------

$sip_request = "";
$response = "";


while (TRUE) {

$sock->recv($sip_request, 5000);
print "Response received: $sip_request\n";

@sip_headers = split(/\r\n/, $sip_request);

print "Number of headers in received message: $#sip_headers\n\n";

print "\n\n-------------------------------------------------\n\n";


#-------------------------------------------------------------

#send 100 Trying
$response = "SIP/2.0 100 Trying\r\n";

foreach $header (@sip_headers) {
if (($header =~ "^From") or ($header =~ "^To") or ($header =~ "^Call-ID") or ($header =~ "^CSeq") or ($header =~ "^Via")) {
$response = $response.$header."\r\n";
}
}

$response = $response."\r\n";

print "Response to be sent: $response\n";

print $sock $response;

#-----------------------------------------------------------

#send 180 Ringing
$response = "SIP/2.0 180 Ringing\r\n";

foreach $header (@sip_headers) {
if (($header =~ "^From") or ($header =~ "^To") or
($header =~ "^Call-ID") or ($header =~ "^CSeq") or
($header =~ "^Via")) {

if ($header =~ "^To") {
$header = $header.";tag=rfsdf677566577";
}
$response = $response.$header."\r\n";
}
}

$response = $response."Contact: ; isfocus\r\nContent-Length:0\r\n";
$response = $response."Record-Route: ,,\r\n";
$response = $response."Require: 100rel\r\nRSeq: 1\r\n";
$response = $response."Content-Type: application/sdp\r\n";

$response = $response."\r\n";

print "Response to be sent: $response\n";

print $sock $response;

#---------------------------------------------------------------
# wait for PRACK

$sock->recv($sip_request, 5000);
print "Response received: $sip_request\n";

@sip_headers = split(/\r\n/, $sip_request);

print "Number of headers in received message: $#sip_headers\n\n";

print "\n\n-------------------------------------------------\n\n";

#-----------------------------------------------------------------

#send 200 OK
$response = "SIP/2.0 200 OK\r\n";

foreach $header (@sip_headers) {
if (($header =~ "^From") or ($header =~ "^To") or
($header =~ "^Call-ID") or ($header =~ "^CSeq") or
($header =~ "^Via")
) {
$response = $response.$header."\r\n";
}
}

$response = $response."Contact: ; isfocus\r\nContent-Length:189\r\n";
$response = $response."Content-Type: application/sdp\r\n";

$response = $response."\r\n";

$response = $response."v=0"."\r\n"."o=RV-MCU 2021970 2021970 IN IP4 10.232.15.31"."\r\n"."s=RV MCU Session\r\n"."c=IN IP4 10.232.15.31"."\r\n"."b=CT:64"."\r\n"."t=0 0"."\r\n"."m=audio 6028 RTP/AVP 8"."\r\n"."c=IN IP4 10.232.15.31"."\r\n"."a=rtpmap:8 PCMA/8000"."\r\n"."a=sendrecv"."\r\n";

print "Response to be sent: $response\n";

print $sock $response;

#---------------------------------------------------------------

#Wait for ACK
$sip_request = "";
@sip_headers = "";

$sock->recv($sip_request, 5000);
print "Response received: $sip_request\n";

@sip_headers = split(/\r\n/, $sip_request);

print "Number of headers in received message: $#sip_headers\n\n";

print "\n\n-------------------------------------------------\n\n";

print "CALL SETUP\n";
sleep 100;

#----------------------------------------------------------------

}

close $sock;
Of course, I am bringing this up in this post because I have found Net::SIP module for perl. That reminded me of my earlier days and this dirty code I used to write. I don't know how I didn't discover this module earlier. However, my experiments with Net::SIP will be part of another post.

Saturday, November 08, 2008

ActivePerl to Strawberry Perl

Activeperl from ActiveState has been the predominant flavour of perl used by many over the years. In addition to the core perl, the package release includes some of the mostly used modules and some win32 specific modules which make the life easier for a developer if he is developing anything for Windows. It also has ppm tool which is quite handful for querying and installing modules and packages from activeperl repository.

However, I have found some irritating issues with activeperl especially if one is developing platform-independant code. First one would be missing packages. For eg support for SSL packages - ssleay and HTTPS support for LWP. I understand that it is not activestate's fault as such since Canadian federal government does not permit distributing of cryptographic software. But it is an annoying thing for a developer since HTTPS is such an important requirement if one is working on any web related programs. Of course, there are work arounds like adding another repository that has them. I have encountered other missing modules like - Net::SIP.

Next in line would be manual compilation on Windows. One can download the source packages from CPAN and try to compile. If the module is a perl only module, then you are in safe land. Compilation and installation will go through. Even for that one needs to have the 'nmake' utility. This is distributed as part of Visual Studio (VS) application by Microsoft. In case one doesn't have VS installed, then one can google for 'nmake' and download it for free else download the express edition of the VS which is free. Probably some tests will fail probably because author made use of *nix specific stuff in the test code, but that's still better than not having anything at all. However if the module has some C code, then you are on your own. It will consume too much effort to proceed.

One of my other grudges is the lack of cpan connectivity. CPAN is one of the reasons why perl is so popular.

Recently I came across strawberryperl. This flavour of win32 perl comes with mingw compiler (gcc for Windows) and other unix utilities for Windows. And has CPAN tool chain with auto-upgrade support. So incase you need a module that's missing, just drop into the cpan shell that's part of the strawberry perl release and install or update the desired module. Incase the module has C source code and needs to be built, then no problem. The mingw compiler and other unix utilities will do the job for you.

Have just started playing around with strawberry perl. If still curious about win32 perl version, then head over to this wiki to quench your thirst.

Update: In the comments, Jan Dubois mentions that most of the issues I have mentioned here have been fixed in the last week's build of the activeperl releases. Thanks Jan for updating. However, I have not tried the latest activeperl releases yet.