Using Perl's Net::Frame::Simple module to rewrite ethernet header - perl

I am using below code (copied from http://search.cpan.org/~gomor/Net-Frame-Simple-1.06/lib/Net/Frame/Simple.pm) to rewrite the ethernet src and dst mac information but its generating bad IP packet.
#!/usr/bin/perl
use Net::Frame::Simple;
use Net::Frame::Layer::IPv4;
use Net::Frame::Layer::TCP;
use Net::Frame::Layer::ETH;
use Net::Frame::Device;
use Net::Write::Layer3;
use Net::Frame::Dump::Online;
use Net::Write::Layer2;
my $src = '100.1.1.39';
my $target = '200.2.2.97';
my $port = 22;
my $eth = Net::Frame::Layer::ETH->new(src => "00:0c:29:d1:03:06", dst => "03:03:03:03:03:03");
my $ip4 = Net::Frame::Layer::IPv4->new(src => $src,dst => $target);
my $tcp = Net::Frame::Layer::TCP->new(dst => $port, options => "\x02\x04\x54\x0b",payload => 'test');
my $oSimple = Net::Frame::Simple->new(layers => [$eth,$ip4,$tcp],);
# Now, the frame is ready to be send to the network
# We open a sender object, and a retriever object
my $oWrite = Net::Write::Layer2->new(dev => 'eth0');
$oWrite = Net::Write::Layer3->new(dst => $target);
#my $oDump = Net::Frame::Dump::Online->new(dev => $oDevice->dev);
#$oDump->start;
$oWrite->open;
# We send the frame
$oSimple->send($oWrite);
If i remove the ethernet part ($eth) when defining layers in $oSimple, it works.
Any suggestions what i am missing or doing wrong?

I was able to make it work
For anyone's reference, if remove the line "Net::Write::Layer3" and just do the writing at layer 2 (Net::Write::Layer2) in above code, you can change the src and dst MACs.

Related

How to loop through subarrays of a SOAP::Lite response in Perl?

I have a Perl script that is successfully getting a response from my ShoreTel Phone server. The server provides information on what calls are currently connected for the extension entered. However I am having issues looping through the sub arrays to get more than one response when there are multiple items. In this case I want to get each of the caller IDs that is currently connected.
My SOAP:LITE request is successfully pulling data from the server using the following code:
use strict;
use warnings;
use SOAP::Lite;
use CGI;
use Data::Dumper;
my $myWebService = SOAP::Lite
-> uri('http://www.ShoreTel.com/ProServices/SDK/Web')
-> proxy('http://10.1.##.##:8070/ShoreTelWebSDK/WebService')
-> on_action(sub {sprintf '%s/ShoreTelWebService/%s', $_[0], $_[1]});
my $query = new CGI;
my $ip = $query->remote_host; # IP address of remote party...use later as unique identifier
my $myClientID = $query->param('MyClientID'); # Possible client ID from previous script passed into us.
my $extnNr = $query->param('MyExtn'); # Has to be at least an extension number so we know who to status.
my $url = CGI::url(-path_info=>1); # What is my URL?
# There should be an extension number given, else what would we status.
if (defined($refreshNr) && defined($extnNr) && ($extnNr ne '') && ($refreshNr ne ''))
{
# If there is a client ID defined, use it...otherwise registering and getting a client ID
# is the first thing we need to do when using our web service.
unless (defined($myClientID))
{
# To use our service, we need to register ourselves as a client...use remote IP address
# as a unique name for association to this session.
my $regClientResult = $myWebService->RegisterClient(SOAP::Data->name('clientName' => $ip));
if ($regClientResult->fault)
{
print '<p>FAULT', $myClientID->faultcode, ', ', $myClientID->faultstring;
}
else
{
# Retrieve client ID which we will be using for subsequent communication.
$myClientID = $regClientResult->valueof('//RegisterClientResponse/RegisterClientResult/');
}
}
if (defined($myClientID))
{
# Use our web service to open the line. This is necessary to get a line ID.
# print '<br>Client ID ', $myClientID, ' has been registered.<br>';
my $openResult = $myWebService->OpenLine(SOAP::Data->name('clientHandle' => $myClientID), SOAP::Data->name('lineAddress' => $extnNr));
my $lineID = $openResult->valueof('//OpenLineResponse/OpenLineResult/lineID/');
my $lineType = $openResult->valueof('//OpenLineResponse/OpenLineResult/lineType/');
my $lineName = $openResult->valueof('//OpenLineResponse/OpenLineResult/lineName/');
my $lineState = $openResult->valueof('//OpenLineResponse/OpenLineResult/lineState/');
# Call GetActiveCalls to see if anything is going on with this line.
my $result = $myWebService->GetActiveCalls(SOAP::Data->name('clientHandle' => $myClientID), SOAP::Data->name('lineID' => $lineID));
my $callID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callID/');
if ($callID ne '')
{
# print '<br>Call ID is ', $callID;
my $isExternal = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/isExternal/');
my $isInbound = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/isInbound/');
my $callReason = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callReason/');
my $connectedID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/connectedID/');
my $connectedIDName = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/connectedIDName/');
my $callerID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/');
my $callerIDName = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerIDName/');
my $calledID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/calledID/');
my $calledIDName = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/calledIDName/');
my $callState = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callState/');
my $callStateDetail = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callStateDetail/');
# Print call information.
print <<EndOfCallInfo;
HTML CODE
EndOfCallInfo
}
else
{
print <<EndOfCallInfo2;
HTML CODE
EndOfCallInfo2
}
}
}
But I am only able to access the first result in the multidimensional array.
I have tried looping through the results using
for my $t ($result->result({ShoreTelCallStateInfo}{callInfo}')) {
print $t->{callerID} . "\n";}
But I am getting absolutely no results. It appears that the the loop is not even entered.
The following code I have works fine, but only pulls the first caller ID, in this case 1955.
my $callerID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/');
What can I do to make my loop work?
So that you can see what I am receiving from the server I have included the response from the SOAP Server using DUMP :
$VAR1 = { 'ShoreTelCallStateInfo' => [
{ 'callStateDetail' => 'Active',
'callState' => 'OnHold',
'callInfo' =>
{ 'callerIDName' => 'Joel LASTNAME',
'callID' => '69105', 'lineID' => '3947',
'connectedIDName' => 'VM-Forward',
'calledID' => '2105',
'callerID' => '1955',
'isInbound' => 'false',
'calledIDName' => 'VM-Forward',
'callReason' => 'None',
'callUniqueID' => '1369702515',
'connectedID' => '2105',
'isExternal' => 'false',
'callGUID' => '{00030000-66C2-537E-3FD8-0010492377D9}'
}
},
{ 'callStateDetail' => 'Active',
'callState' => 'Connected',
'callInfo' =>
{ 'callerIDName' => 'LASTNAME Joel ',
'callID' => '71649',
'lineID' => '3947',
'connectedIDName' => 'LASTNAME Joel ',
'calledID' => '1955',
'callerID' => '+1385#######',
'isInbound' => 'true',
'calledIDName' => 'Joel LASTNAME',
'callReason' => 'None',
'callUniqueID' => '1117287558',
'connectedID' => '+1385#######',
'isExternal' => 'true',
'callGUID' => '{00030000-66C5-537E-3FD8-0010492377D9}'
}
}
]
};
Just a guess...
The following code I have works fine, but only pulls the first caller
ID, in this case 1955.
my $callerID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/');
What can I do to make my loop work?
SOAP::Lite docs say:
valueof()
Returns the value of a (previously) matched node. It accepts a node
path. In this case, it returns the value of matched node, but does not
change the current node. Suitable when you want to match a node and
then navigate through node children:
$som->match('/Envelope/Body/[1]'); # match method
$som->valueof('[1]'); # result
$som->valueof('[2]'); # first out parameter (if present)
The returned value depends on the context. In a scalar context it will
return the first element from matched nodeset. In an array context it
will return all matched elements.
Does this give the behavior you expect? It imposes list context on the valueof method.
for my $callerID ($result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/')) {
...
# do something with each callerID
}
or
my #callerIDs = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/');

Passing Parameter to Test::Class Setup method

I need to invoke a browser in selenium dynamically.
To achieve this I need to send the browser name as parameter to the set-up or start-up methods in Test::Class. How do I achieve this?
I take it you want to get a browser, then reuse it for some tests, then destroy it later? So just use a global to hold the browser you create. For example:
my $browser = '';
sub b_connect : Test(startup) {
$browser = WWW::Selenium->new( host => "localhost",
port => 4444,
browser => "*iexplore",
browser_url => "http://www.google.com",
);
};
sub b_disconnect : Test(shutdown) {
$browser->close()
};
Just use the $browser var in you tests.
sub startup : Test( startup ) {
my ($self) = #_;
my $arg = shift;
$self->{browser_type} = $arg->{browser};
-------------------------------#some other code for myself
$self->{browser} =
Test::WWW::Selenium->new(
host => $self->{host},
port => $self->{port},
browser => $self->{browser_type},
browser_url => $self->{test_url},
);
In my test script I need it to call using the following
my $t1 = Test::Class::Selenium::TestCases->new(browser=>$browser,);
Test::Class->runtests($t1);

How to send an IP broadcast message using Perl

I've tried both Net::RawIP and Net::Write::Layer3. It works fine if i supply a specific ip address in the network. while i'm getting either
sendto() at /usr/lib/perl5/Net/RawIP.pm line 630. shell returned 13
or
Net::Write::Layer::send: Permission denied
if i change the destination address to 66.66.66.255
any ideas?
the code i'm using is here
use Net::Write::Layer qw(:constants);
use Net::Write::Layer3;
use NetAddr::IP;
use Net::RawIP;
$message = "Foo";
# using Net::RawIP
$n = Net::RawIP->new({
ip => {
tos => 0xC0,
daddr => '66.66.66.2',
protocol => 2,
},
generic => {
data => $message
}
});
$n->send;
# using Net::Write::Layer3
my $desc = Net::Write::Layer3->new(
dst => '66.66.66.2',
protocol => '2',
family => NW_AF_INET,
);
$desc->open;
$desc->send($message);
$desc->close;
Error 13 is usually EACCES - i.e. you do not have sufficient permission to send to a broadcast socket.

How to stop listening on an HTTP::Daemon port in Perl

I have a basic perl HTTP server using HTTP::Daemon. When I stop and start the script, it appears that the port is still being listened on and I get an error message saying that my HTTP::Daemon instance is undefined. If I try to start the script about a minute after it has stopped, it works fine and can bind to the port again.
Is there any way to stop listening on the port when the program terminates instead of having to wait for it to timeout?
use HTTP::Daemon;
use HTTP::Status;
my $d = new HTTP::Daemon(LocalAddr => 'localhost', LocalPort => 8000);
while (my $c = $d->accept) {
while (my $r = $c->get_request) {
$c->send_error(RC_FORBIDDEN)
}
$c->close;
undef($c);
}
EDIT:
As per DVK's response, I tried calling $d->close() but am still getting the same error when trying to restart my script.
END { $d->close(); }
$SIG{'INT'} = 'CLEANUP';
$SIG{__WARN__} = 'CLEANUP';
$SIG{__DIE__} = 'CLEANUP';
sub CLEANUP {
$d->close();
undef($d);
print "\n\nCaught Interrupt (^C), Aborting\n";
exit(1);
}
I found a solution to my problem by setting ReuseAddr => 1 when creating the HTTP::Daemon.
my $d = new HTTP::Daemon(
ReuseAddr => 1,
LocalAddr => 'localhost',
LocalPort => 8000);
Did you try $d->close() at the end of the program?
If not, try that. It's not documented in HTTP::Daemon POD example but the method should be available (inherited from IO::Socket)
Remember that you might need to be creative about where to call it, e.g. it might need to go into __DIE__ handler or END {} block

Why does Perl's Net::Msmgr hang when I try to authenticate?

There's Net::Msmgr module on CPAN. It's written clean and the code looks trustworthy at the first glance. However this module seems to be beta and there is little documentation and no tests :-/
Has anyone used this module in production? I haven't managed to make it run by now, because it requires all event loop processing to be done in the application and as I've already said there is little documentation and no working examples to study.
That's where I've gone so far:
#!/usr/bin/perl
use strict;
use warnings;
use Event;
use Net::Msmgr::Object;
use Net::Msmgr::Session;
use Net::Msmgr::User;
use constant DEBUG => 511;
use constant EVENT_TIMEOUT => 5; # seconds
my ($username, $password) = qw/my.username#live.com my.password/;
my $buddy = 'your.username#live.com';
my $user = Net::Msmgr::User->new(user => $username, password => $password);
my $session = Net::Msmgr::Session->new;
$session->debug(DEBUG);
$session->login_handler(\&login_handler);
$session->user($user);
my $conv;
sub login_handler {
my $self = shift;
print "LOGIN\n";
$self->ui_state_nln;
$conv = $session->ui_new_conversation;
$conv->invite($buddy);
}
our %watcher;
sub ConnectHandler {
my ($connection) = #_;
warn "CONNECT\n";
my $socket = $connection->socket;
$watcher{$connection} = Event->io(fd => $socket,
cb => [ $connection, '_recv_message' ],
poll => 're',
desc => 'recv_watcher',
repeat => 1);
}
sub DisconnectHandler {
my $connection = shift;
print "DISCONNECT\n";
$watcher{$connection}->cancel;
}
$session->connect_handler(\&ConnectHandler);
$session->disconnect_handler(\&DisconnectHandler);
$session->Login;
Event::loop();
That's what it outputs:
Dispatch Server connecting to: messenger.hotmail.com:1863
Dispatch Server connected
CONNECT
Dispatch Server >>>VER 1 MSNP2 CVR0
--> VER 1 MSNP2 CVR0
Dispatch Server >>>USR 2 MD5 I my.username#live.com
--> USR 2 MD5 I my.username#live.com
Dispatch Server <<<VER 1 CVR0
<-- VER 1 CVR0
And that's all, here it hangs. The handler on login is not being triggered. What am I doing wrong?
Hope these documents will help you out
1) Net::Msmgr documentation
2) Net::Msmgr::Session