cvsroot/AnyEvent-Porttracker/Porttracker.pm

=head1 NAME

AnyEvent::Porttracker - Porttracker/PortIQ API client interface.

=head1 SYNOPSIS

   use AnyEvent::Porttracker;

=head1 DESCRIPTION

Porttracker (L<http://www.porttracker.com/>) 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<AnyEvent> 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<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>.

=head1 AUTHOR

 Marc Lehmann <marc@porttracker.net>

=cut

1
Revision:	1.1
Committed:	Mon Nov 15 04:39:36 2010 UTC (13 years, 8 months ago) by root
Branch:	MAIN
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::Porttracker - Porttracker/PortIQ API client interface.
4
5			=head1 SYNOPSIS
6
7			use AnyEvent::Porttracker;
8
9			=head1 DESCRIPTION
10
11			Porttracker (L<http://www.porttracker.com/>) is a product that (among
12			other things) scans switches and routers in a network and gives a coherent
13			view of which end devices are connected to which switch ports on which
14			switches and routers. It also offers a JSON-based client API, for which
15			this module is an implementation.
16
17			In addition to Porttracker, the PortIQ product is also supported, as it
18			uses the same protocol.
19
20			If you do not have access to either a Porttracker or PortIQ box then this
21			module will be of little value to you.
22
23			This module is an L<AnyEvent> user, you need to make sure that you use and
24			run a supported event loop.
25
26			=head1 THE AnyEvent::Porttracker CLASS
27
28			=over 4
29
30			=cut
31
32			package AnyEvent::Porttracker;
33
34			use common::sense;
35
36			use Scalar::Util ();
37
38			use AnyEvent ();
39			use AnyEvent::Handle ();
40
41			use MIME::Base64 ();
42			use Digest::HMAC_MD6 ();
43			use JSON ();
44
45			our $VERSION = '0.0';
46
47			sub call {
48			my ($self, $type, @args) = @_;
49
50			$self->{$type}
51			? $self->{$type}($self, @args)
52			: $type = (UNIVERSAL::can $self, $type)
53			? $type->($self, @args)
54			: ()
55			}
56
57			=item new AnyEvent::Porttracker
58
59			=cut
60
61			sub new {
62			my $class = shift;
63
64			my $self = bless {
65			id => "a",
66			@_,
67			}, $class;
68
69			{
70			Scalar::Util::weaken (my $self = $self);
71
72			$self->{hdl} = new AnyEvent::Handle
73			connect => [$self->{host}, $self->{port} \|\| "porttracker=55"],
74			on_error => sub {
75			$self->error ();
76			},
77			on_read => sub {
78			while ($_[0]{rbuf} =~ s/^([^\x0a]*)\x0a//) {
79			my $msg = JSON::decode_json $1;
80			my $id = shift @$msg;
81
82			if (defined $id) {
83			my $cb = delete $self->{cb}{$id}
84			or return $self->error ("received unexpected reply msg with id $id");
85
86			$cb->($self, @$msg);
87			} else {
88			$msg->[0] = "on_$msg->[0]_notify";
89			call $self, @$msg;
90			}
91			}
92			},
93			;
94			}
95
96			$self
97			}
98
99			sub DESTROY {
100			my ($self) = @_;
101
102			$self->{hdl}->destroy
103			if $self->{hdl};
104			}
105
106			sub error {
107			my ($self, $msg) = @_;
108
109			warn $msg;
110
111			()
112			}
113
114			sub send {
115			my $self = shift;
116			my $cb = pop;
117
118			my $id = ++$self->{id};
119
120			unshift @_, $id;
121			$self->{cb}{$id} = $cb;
122
123			my $msg = JSON::encode_json \@_;
124
125			$self->{hdl}->push_write ($msg);
126			}
127
128			sub on_hello_notify {
129			my ($self, $version, $auths, $nonce) = @_;
130
131			$version == 1
132			or return $self->error ("protocol mismatch, got $version, expected/supported 1");
133
134			$nonce = MIME::Base64::decode_base64 $nonce;
135
136			if (grep $_ eq "none", @$auths) {
137			# successfully authenticated...
138			} elsif (grep $_ eq "login_cram_md6", @$auths) {
139			my $cc = join "", map chr 256 * rand, 0..63;
140
141			my $key = Digest::HMAC_MD6::hmac_md6 $self->{password}, $self->{username}, 64, 256;
142			my $cr = Digest::HMAC_MD6::hmac_md6_base64 $key, "$cc$nonce", 64, 256;
143			my $sr = Digest::HMAC_MD6::hmac_md6_base64 $key, "$nonce$cc", 64, 256;
144
145			$cc = MIME::Base64::encode_base64 $cc;
146
147			$self->send (login_cram_md6 => $self->{username}, $cr, $cc, sub {
148			my ($self, $ok, $msg) = @_;
149
150			$ok
151			or return call $self, on_login_failure => $msg;
152
153			$msg eq $sr
154			or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack";
155
156			call $self, "on_login"
157			});
158			} elsif (grep $_ eq "login", @$auths) {
159			$self->send (login => $self->{username}, $self->{password}, sub {
160			my ($self, $ok, $msg) = @_;
161
162			$ok
163			or return call $self, on_login_failure => $msg;
164
165			call $self, "on_login"
166			});
167			} else {
168			return $self->error ("no supported auth method (@$auths)");
169			}
170			}
171
172			sub on_login_failure {
173			my ($self, $msg) = @_;
174
175			$msg =~ s/\n$//;
176			$self->error ("login failed: $msg");
177			}
178
179			=back
180
181			=head1 SEE ALSO
182
183			L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>.
184
185			=head1 AUTHOR
186
187			Marc Lehmann <marc@porttracker.net>
188
189			=cut
190
191			1