=head1 NAME
AnyEvent::Porttracker - Porttracker/PortIQ API client interface.
=head1 SYNOPSIS
use AnyEvent::Porttracker;
=head1 DESCRIPTION
Porttracker (L) is a product that (among
other things) scans switches and routers in a network and gives a coherent
view of which end devices are connected to which switch ports on which
switches and routers. It also offers a JSON-based client API, for which
this module is an implementation.
In addition to Porttracker, the PortIQ product is also supported, as it
uses the same protocol.
If you do not have access to either a Porttracker or PortIQ box then this
module will be of little value to you.
This module is an L user, you need to make sure that you use and
run a supported event loop.
=head1 THE AnyEvent::Porttracker CLASS
=over 4
=cut
package AnyEvent::Porttracker;
use common::sense;
use Scalar::Util ();
use AnyEvent ();
use AnyEvent::Handle ();
use MIME::Base64 ();
use Digest::HMAC_MD6 ();
use JSON ();
our $VERSION = '0.0';
sub call {
my ($self, $type, @args) = @_;
$self->{$type}
? $self->{$type}($self, @args)
: $type = (UNIVERSAL::can $self, $type)
? $type->($self, @args)
: ()
}
=item new AnyEvent::Porttracker
=cut
sub new {
my $class = shift;
my $self = bless {
id => "a",
@_,
}, $class;
{
Scalar::Util::weaken (my $self = $self);
$self->{hdl} = new AnyEvent::Handle
connect => [$self->{host}, $self->{port} || "porttracker=55"],
on_error => sub {
$self->error ();
},
on_read => sub {
while ($_[0]{rbuf} =~ s/^([^\x0a]*)\x0a//) {
my $msg = JSON::decode_json $1;
my $id = shift @$msg;
if (defined $id) {
my $cb = delete $self->{cb}{$id}
or return $self->error ("received unexpected reply msg with id $id");
$cb->($self, @$msg);
} else {
$msg->[0] = "on_$msg->[0]_notify";
call $self, @$msg;
}
}
},
;
}
$self
}
sub DESTROY {
my ($self) = @_;
$self->{hdl}->destroy
if $self->{hdl};
}
sub error {
my ($self, $msg) = @_;
warn $msg;
()
}
sub send {
my $self = shift;
my $cb = pop;
my $id = ++$self->{id};
unshift @_, $id;
$self->{cb}{$id} = $cb;
my $msg = JSON::encode_json \@_;
$self->{hdl}->push_write ($msg);
}
sub on_hello_notify {
my ($self, $version, $auths, $nonce) = @_;
$version == 1
or return $self->error ("protocol mismatch, got $version, expected/supported 1");
$nonce = MIME::Base64::decode_base64 $nonce;
if (grep $_ eq "none", @$auths) {
# successfully authenticated...
} elsif (grep $_ eq "login_cram_md6", @$auths) {
my $cc = join "", map chr 256 * rand, 0..63;
my $key = Digest::HMAC_MD6::hmac_md6 $self->{password}, $self->{username}, 64, 256;
my $cr = Digest::HMAC_MD6::hmac_md6_base64 $key, "$cc$nonce", 64, 256;
my $sr = Digest::HMAC_MD6::hmac_md6_base64 $key, "$nonce$cc", 64, 256;
$cc = MIME::Base64::encode_base64 $cc;
$self->send (login_cram_md6 => $self->{username}, $cr, $cc, sub {
my ($self, $ok, $msg) = @_;
$ok
or return call $self, on_login_failure => $msg;
$msg eq $sr
or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack";
call $self, "on_login"
});
} elsif (grep $_ eq "login", @$auths) {
$self->send (login => $self->{username}, $self->{password}, sub {
my ($self, $ok, $msg) = @_;
$ok
or return call $self, on_login_failure => $msg;
call $self, "on_login"
});
} else {
return $self->error ("no supported auth method (@$auths)");
}
}
sub on_login_failure {
my ($self, $msg) = @_;
$msg =~ s/\n$//;
$self->error ("login failed: $msg");
}
=back
=head1 SEE ALSO
L, L, L.
=head1 AUTHOR
Marc Lehmann
=cut
1