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

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

Related

[ Undefined subroutine]: Net::Frame::Dump::Online: Must be EUID 0

I am new using Perl language, and I am following a book to begin with some advanced scanning network (as that's why I am learning Perl for)
so the program looks like that:
#!/usr/bin/perl -w
use strict;
use Net::Pcap qw( :functions );
use Net::Frame::Device;
use Net::Netmask;
use Net::Frame::Dump::Online;
use Net::ARP;
use Net::Frame::Simple;
my $err = "";
my $dev = pcap_lookupdev(\$err); # from Net::Pcap
my $devProp = Net::Frame::Device->new(dev => $dev);
my $ip = $devProp->ip;
my $gateway = $devProp->gatewayIp;
my $netmask = new Net::Netmask($devProp->subnet);
my $mac = $devProp->mac;
my $netblock = $ip . ":" . $netmask->mask();
my $filterStr = "arp and dst host ".$ip;
my $pcap = Net::Frame::Dump::Online->new(
dev => $dev,
filter => $filterStr,
promisc => 0,
unlinkOnStop => 1,
timeoutOnNext => 10 # waiting for ARP responses
);
$pcap->start;
print "Gateway IP: ",$gateway,"\n","Starting scan\n";
for my $ipts ($netmask->enumerate){
Net::ARP::send_packet(
$dev,
$ip,
$ipts,
$mac,
"ff:ff:ff:ff:ff:ff", # broadcast
"request");
}
until ($pcap->timeout){
if (my $next = $pcap->next){ # frame according to $filterStr
my $fref = Net::Frame::Simple->newFromDump($next);
# we don’t have to worry about the operation codes 1, or 2
# because of the $filterStr
print $fref->ref->{ARP}->srcIp," is alive\n";
}
}
END{ print "Exiting\n"; $pcap->stop; }
However, when I run ./script.pl I am getting this error:
Undefined subroutine &main::pcap_lookupdev called at ./scan_ARP.pl line 13.
Exiting
Can't call method "stop" on an undefined value at ./scan_ARP.pl line 48.
END failed--call queue aborted.
and as mentionned in the book, I can replace my $dev = pcap_lookupdev(\$err); directly with my $dev = "wlp0s20f3" (wlp0s20f3; is the name of my network interface), but when I do that, I get:
[-]: Net::Frame::Dump::Online: Must be EUID 0 (or equivalent) to open a device for live capture
Exiting
Can't kill a non-numeric process ID at /usr/share/perl5/Net/Frame/Dump/Online.pm line 363.
END failed--call queue aborted.
So I found out that to solve the problem, I have to run the script as a root.

Managing session state with html::mason

I'm using HTML::Mason with Apache2 mod_perl2 for a project and am unsure what's a good way to manage session state easily.
Please don't say use Catalyst. I normally do, but not on this occasion.
After struggling with this for a long time I finally have a working solution:
This is using mysql to store session data so that no matter which front-end server you hit, you will get the same session data.
You will need a db with a table called sessions made with this:
CREATE TABLE sessions (id char(32), length int, a_session text);
This is in MySession.pm in my INC path.
package MySession;
use DBI();
use Apache::Session::MySQL;
use Apache2::Cookie;
sub start_session($){
my ($r) = #_;
my $cookie_name = 'mysite-session';
my $cookie_domain = '.mysite.com';
my $dsn = "DBI:mysql:database=db;host=host.com";
my $dbuser = 'admin';
my $dbpass = 'password';
my $dbh = DBI->connect($dsn, $dbuser, $dbpass, {'RaiseError' => 1});
my $session_cookie = Apache2::Cookie->fetch($r)->{$cookie_name};
my %cookie_hash;
if(defined($session_cookie)){
%cookie_hash = $session_cookie->value();
}
tie my %session, 'Apache::Session::MySQL', $cookie_hash{SessionID}, {
Handle => $dbh,
LockHandle => $dbh
};
my $cookie = Apache2::Cookie->new($r,
-name => $cookie_name,
-domain => $cookie_domain,
-value => {SessionID => $session{_session_id}}
);
$cookie->bake($r);
return \%session;
}
1;
Then on any page you wish to use/modify session data:
% use MySession;
% my $session = MySession::start_session($r);
% $session->{variable} = "Wow, I have a cookie";
Looks like I've found the answer in
MasonX::Request::WithApacheSession

Perl SSH connection to execute telnet

I tried the following to access a router via a central admin server as "ssh hop" server
#!/usr/bin/perl -X
use strict;
use Net::OpenSSH;
use Net::Telnet;
my $lhost = "linuxserver";
my $luser = "linuxuser";
my $lpass = "linuxpassword";
my $chost = "routername";
my $cpass = "Routerpassword";
my $prompt = '/(?:Password: |[>])/m';
my #commands = ("show users\r");
my $ssh = Net::OpenSSH->new($lhost,
'user' => $luser,
'password' => $lpass,
'master_opts' => [ '-t' ],
#'async' => 1 # if enabled then password cannot be set here
);
my ($pty, $err, $pid) = $ssh->open2pty("telnet $chost");
my $t = new Net::Telnet(
-telnetmode => 0,
-fhopen => $pty,
-prompt => $prompt,
-cmd_remove_mode => 1,
-output_record_separator => "\r",
#-dump_log => "debug.log",
);
my $end = 0;
while (!$end) {
my ($pre, $post) = $t->waitfor($prompt);
if ($post =~ /Password: /m) {
# send password
$t->print("$cpass");
}
elsif ($post =~ /[>#]/ && #commands) {
my $cmd = shift(#commands);
if ($cmd !~ /[\r\n]/) {
$t->print($cmd);
}
else {
print $t->cmd($cmd);
}
}
else {
$end = 1;
$t->cmd("exit");
}
}
#close $pty;
$t->close();
Unfortunately I always get the following error:
read error: Input/output error at test.pl line 71
Can somebody help me please or is there a better solution only to test if a telnet connection via the "hop" server is possible or not?
The connection looks like:
workstation --ssh-> server --telnet-> router
Thanks in advance.
I think best option is to make an SSH-tunnel to your admin server and use it for telnetting to the router.
Getting Net::Telnet to work over Net::OpenSSH sometimes is not as easy as it should be and it requires some experimentation to get to the right combination of flags and calls that make it work.
For instance, instead of telneting to the target host, use netcat to open a raw connection (or Net::OpenSSH support for TCP forwarding if tunnels are allowed on the proxy).
Expect + Net::OpenSSH may be a better option.

OpenID authentication to Google Apps via Perl and Net::OpenID::Consumer fails

I asked this over on Google's support forums for Apps integration, but got zero response. Maybe somebody here can help steer me in the right direction.
I'm trying to integrate a Perl application with Google Apps, and I'm having some trouble with the OpenID authentication. I've been using this PHP tutorial from Google as a kind of reference, since there are no Perl examples I can find.
My initial file, index.cgi (referred by manifest.xml, and the starting point of the OpenID transaction) is as follows:
use Net::OpenID::Consumer;
use CGI;
# ...
my $q = CGI->new();
my $domain = $q->param('domain');
if (!$domain) {
print $q->header(), 'Provide domain please.';
exit 0;
}
# my website
my $root = 'http://www.example.com/';
my $csr = Net::OpenID::Consumer->new(
# The user agent which sends the openid off to the server
ua => LWP::UserAgent->new,
# Who we are
required_root => $root,
# Consumer Key Secret from Google Apps Marketplace
consumer_secret => 'Zzzzzz9zzAAAAA....'
);
my $claimed_id = $csr->claimed_identity(
'https://www.google.com/accounts/o8/site-xrds?hd=' . $domain);
if ($claimed_id) {
my $check_url = $claimed_id->check_url(
# Upon validation, the user will be returned here, and real
# work may begin
return_to => $root . '/return.cgi',
trust_root => $root
);
print $q->redirect($check_url);
}
else {
print $q->header(), "Error";
}
This part seems to be working. That is, I get redirected to return.cgi with a bunch of openid.* parameters. However, at this point I get the following error:
no_identity_server The provided URL doesn't declare its OpenID identity server
I'm using the latest version of the Net::OpenID::Consumer module.
Here are the significant bits of return.cgi:
my $q = CGI->new();
my $csr = Net::OpenID::Consumer->new(
ua => LWP::UserAgent->new,
# The root of our URL
required_root => 'http://www.example.com/',
# Our password.
consumer_secret => 'Zzzzzz9zzAAAAA....',
# Where to get the information from.
args => $q
);
print $q->header();
$csr->handle_server_response(
not_openid => sub {
print "That's not an OpenID message. Did you just type in the URL?";
},
setup_required => sub {
my $setup_url = shift;
print 'You need to do something here.';
},
cancelled => sub {
print 'You cancelled your login.';
},
verified => sub {
my $vident = shift;
my $url = $vident->url;
print "You are verified as '$url'. ** FIN **";
},
error => sub { die "Can't figure it out: ", #_; }
);
As you can imagine, I'm wanting the verified sub to fire, but instead I'm getting an error. Anything obvious I'm missing? Any help would be appreciated.
So the solution, it turns out, is to switch modules. I changed to the skimpily documented Net::Google::FederatedLogin, and things are now working. The code is as follows (substitute example.com below for your actual developer's domain).
In your Google Apps Marketplace vendor profile, add the URL to index.cgi in the Application Manifest:
...
<Url>http://www.example.com/index.cgi?from=google&domain=${DOMAIN_NAME}</Url>
...
Then add the following code to your servers.
index.cgi
use CGI;
use Net::Google::FederatedLogin;
my $q = CGI->new();
my $domain = $q->param('domain');
if (!$domain) {
print $q->header(), 'Provide domain please.';
exit 0;
}
my $fl = Net::Google::FederatedLogin->new(
claimed_id =>
'https://www.google.com/accounts/o8/site-xrds?hd=' . $domain,
return_to =>
'http://www.example.com/return.cgi',
extensions => [
{
ns => 'ax',
uri => 'http://openid.net/srv/ax/1.0',
attributes => {
mode => 'fetch_request',
required => 'email',
type => {
email => 'http://axschema.org/contact/email'
}
}
}
] );
print $q->redirect($fl->get_auth_url());
return.cgi
use CGI;
use Net::Google::FederatedLogin;
my $q = CGI->new();
print $q->header();
my $fl = Net::Google::FederatedLogin->new(
cgi => $q,
return_to =>
'http://www.example.com/return.cgi' );
eval { $fl->verify_auth(); };
if ($#) {
print 'Error: ' . $#;
}
else {
# we've authenticated and gotten attributes --
my $ext = $fl->get_extension('http://openid.net/srv/ax/1.0');
print $ext->get_parameter('value.email');
}
(For a full sample, plus OAuth access to user data, see this post on my blog.)
In some cases, reportedly, this is caused by Perl missing Net::SSL, making it fail on Google's SSL URLs.
The step where it's failing is where it performs discovery on the identifier asserted by Google's server. For some reason discovery on that identifier URL is failing. It would be helpful to know what OpenID identifier the Google server is asserting to try to debug why discovery is not working for it.
I'm not sure what $domain is there, but you may need to escape it:
use URI::Escape 'uri_escape';
....
my $claimed_id = $csr->claimed_identity(
'https://www.google.com/accounts/o8/site-xrds?hd=' . uri_escape($domain) );
Also, the consumer_secret used by Net::OpenID::Consumer has no relationship to any other secret.

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