[ViewVC] Diff of: cvs/cvsroot/AnyEvent-Porttracker/Porttracker.pm

Comparing cvsroot/AnyEvent-Porttracker/Porttracker.pm (file contents):
Revision 1.5 by root, Mon Nov 15 20:43:11 2010 UTC vs.
Revision 1.14 by root, Tue Nov 16 19:43:15 2010 UTC

 AnyEvent::Porttracker - Porttracker/PortIQ API client interface.
 =head1 SYNOPSIS
    use AnyEvent::Porttracker;
+   my $api = new AnyEvent::Porttracker
+      host => "10.0.0.1",
+      user => "admin",
+      pass => "31331",
+      tls  => 1,
+   ;
+   # Example 1
+   # a simple request: ping the server
+   $api->req ("ping", sub {
+      my ($api, $ok, $timestamp, $pid) = @_;
+      ...
+   });
+   # Example 2
+   # find all realms, start a discovery on all of them
+   # and wait until all discovery processes have finished
+   my $cv = AE::cv;
+   $cv->begin;
+   # find all realms
+   $api->req (realm_info => ["gid", "name"], sub {
+      my ($api, @realms) = @_;
+      # start discovery on all realms
+      for my $realm (@realms) {
+         my ($gid, $name) = @$realm;
+         $cv->begin;
+         $api->req (realm_discover => $gid, sub {
+            warn "discovery for realm '$name' finished\n";
+            $cv->end;
+         });
+      }
+      $cv->end;
+   });
+   $cv->recv;
+   # Example 3
+   # subscribe to realm_poll_stop events and report each occurance
+   $api->req (subscribe => "realm_poll_stop", sub {});
+   $api->on (realm_poll_stop_event => sub {
+      my ($api, $gid) = @_;
+      warn "this just in: poll for realm <$gid> finished.\n";
+   });
 =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
 use MIME::Base64 ();
 use Digest::HMAC_MD6 ();
 use JSON ();
-our $VERSION = '0.0';
+our $VERSION = '0.1';
 sub call {
    my ($self, $type, @args) = @_;
    $self->{$type}
 =item user => $string, pass => $string
 These are the username and password to use when authentication is required
 (which it is in almost all cases, so these keys are normally mandatory).
-=item tls => ...
+=item tls => $bool
-#TODO#
+Enables or disables TLS (default: disables). When enabled, then the
+connection will try to handshake a TLS connection before logging in. If
+unsuccessful a fatal error will be raised.
+Since most Porttracker/PortIQ boxes will not have a sensible/verifiable
+certificate, no attempt at verifying it will be done (which means
+man-in-the-middle-attacks will be trivial). If you want some form of
+verification you need to provide your own C<tls_ctx> object with C<<
+verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode
+you wish to use.
+=item tls_ctx => $tls_ctx
+The L<AnyEvent::TLS> object to use. See C<tls>, above.
 =item on_XYZ => $coderef
-You can specify event callbacks either by subclassing and overriding the
+You can specify event callbacks either by sub-classing and overriding the
-respective methods or by specifying coderefs as key-value pairs when
+respective methods or by specifying code-refs as key-value pairs when
-constructing the object.
+constructing the object. You add or remove event handlers at any time with
+the C<event> method.
 =back
 =cut
    my $class = shift;
    my $self = bless {
       id    => "a",
       ids   => [],
-      queue => [], # ininitially queue everything
+      queue => [], # initially queue everything
       @_,
    }, $class;
    {
       Scalar::Util::weaken (my $self = $self);
       $self->{hdl} = new AnyEvent::Handle
          connect  => [$self->{host}, $self->{port} || "porttracker=55"],
          on_error => sub {
-            $self->error ();
+            $self->error ($_[2]);
          },
          on_connect => sub {
             if ($self->{tls}) {
                $self->_req (start_tls => sub {
                   $_[1]
 }
 sub error {
    my ($self, $msg) = @_;
-   call on_error => $msg;
+   call $self, on_error => $msg;
    ()
 }
 sub _req {
    my $msg = JSON::encode_json \@_;
    $self->{hdl}->push_write ($msg);
 }
-=item $api->req ($type => @args, $callback->($api, @args))
+=item $api->req ($type => @args, $callback->($api, @reply))
 Sends a generic request of type C<$type> to the server. When the server
-responds, the API object and the response arguments are passed to the
+responds, the API object and the response arguments (without the success
-callback, which is the last argument to this method.
+status) are passed to the callback, which is the last argument to this
+method.
+If the request fails, then a fatal error will be raised. If you want to
+handle failures gracefully, you need to use C<< ->req_failok >> instead.
 The available requests are documented in the Porttracker API
 documentation (a copy of which is included in this module as
 L<AnyEvent::Porttracker::protocol>.
    });
 =cut
 sub req {
+   my $cb = pop;
+   push @_, sub {
+      splice @_, 1, 1
+         or $_[0]->error ($_[1]);
+      &$cb
+   };
    $_[0]{queue}
       ? push @{ $_[0]{queue} }, [@_]
       : &_req
 }
+=item $api->req_failok ($type => @args, $callback->($api, $success, @reply))
+Just like C<< ->req >>, with two differences: first, a failure will not
+raise an error, second, the initial status reply which indicates success
+or failure is not removed before calling the callback.
+=cut
+sub req_failok {
+   $_[0]{queue}
+      ? push @{ $_[0]{queue} }, [@_]
+      : &_req
+}
+=item $api->on (XYZ => $callback)
+Overwrites any currently registered handler for C<on_XYZ> or
+installs a new one. Or, when C<$callback> is undef, unregisters any
+currently-registered handler.
+Example: replace/set the handler for C<on_discover_stop_event>.
+   $api->on (discover_stop_event => sub {
+      my ($api, $gid) = @_;
+      ...
+   });
+=cut
+sub on {
+   my $self = shift;
+   while (@_) {
+      my ($event, $cb) = splice @_, 0, 2;
+      $event =~ s/^on_//;
+      $self->{"on_$event"} = $cb;
+   }
+}
 sub on_start_tls_notify {
    my ($self) = @_;
-   $self->{hdl}->starttls ("connect");
+   $self->{hdl}->starttls (connect => $self->{tls_ctx});
    $self->{tls} ||= 1;
    $self->_login;
 }
    $msg =~ s/\n$//;
    $self->error ("login failed: $msg");
 }
+sub on_event_notify {
+   my ($self, $event, @args) = @_;
+   call $self, "on_${event}_event", @args;
+}
 =back
-=head2 EVENTS
+=head1 EVENTS/CALLBACKS
-AnyEvent::Porttracker conenctions are fully event-driven, and naturally
+AnyEvent::Porttracker connections are fully event-driven, and naturally
 there are a number of events that can occur. All these events have a name
 starting with C<on_> (example: C<on_login_failure>).
 Programs can catch these events in two ways: either by providing
-constructor arguments with the event name as key and a coderef as value:
+constructor arguments with the event name as key and a code-ref as value:
    my $api = new AnyEvent::Porttracker
       host => ...,
       user => ..., pass => ...,
       on_error => sub {
          warn $msg;
          exit 1;
       },
    ;
-Or by subclassing C<AnyEvent::Porttracker> and overriding methods of the
+Or by sub-classing C<AnyEvent::Porttracker> and overriding methods of the
 same name:
    package MyClass;
    use base AnyEvent::Porttracker;
 =item on_start_tls_notify $api
 Called when the server wants to start TLS negotiation. This is used
 internally and - while it is possible to override it - should not be
-overriden.
+overridden.
+=item on_event_notify $api, $eventname, @args
+Called when the server broadcasts an event the API object is subscribed
+to. The default implementation (which should not be overridden) simply
+re-issues an "on_eventname_event" event with the @args.
 =item on_XYZ_notify $api, ...
 In general, any protocol notification will result in an event of the form
 C<on_NOTIFICATION_notify>.
+=item on_XYZ_event $api, ...
+Called when the server broadcasts the named (XYZ) event.
 =back
 =head1 SEE ALSO
 L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>.

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing cvsroot/AnyEvent-Porttracker/Porttracker.pm (file contents): Revision 1.5 by root, Mon Nov 15 20:43:11 2010 UTC vs. Revision 1.14 by root, Tue Nov 16 19:43:15 2010 UTC

Diff Legend

Comparing cvsroot/AnyEvent-Porttracker/Porttracker.pm (file contents):
Revision 1.5 by root, Mon Nov 15 20:43:11 2010 UTC vs.
Revision 1.14 by root, Tue Nov 16 19:43:15 2010 UTC