view release on metacpan or  search on metacpan

FCP.pm  view on Meta::CPAN

The hostname or IP address of the freenet node. Default is C<$ENV{FREDHOST}>
or C<127.0.0.1>.

=item port => $portnumber

The port number of the FCP port. Default is C<$ENV{FREDPORT}> or C<9481>.

=item timeout => $seconds

The timeout, in seconds, after which a connection error is assumed when
there is no activity. Default is C<7200>, i.e. two hours.

=item keepalive => $seconds

The interval, in seconds, at which keepalive messages will be
sent. Default is C<540>, i.e. nine minutes.

These keepalive messages are useful both to detect that a connection is
no longer working and to keep any (home) routers from expiring their
masquerading entry.

=item on_eof => $callback->($fcp)

Invoked when the underlying L<AnyEvent::Handle> signals EOF, currently
regardless of whether the EOF was expected or not.

=item on_error => $callback->($fcp, $message)

Invoked on any (fatal) errors, such as unexpected connection close. The
callback receives the FCP object and a textual error message.

=item on_failure => $callback->($fcp, $type, $backtrace, $args, $error)

Invoked when an FCP request fails that didn't have a failure callback. See
L<FCP REQUESTS> for details.

=back

=cut

sub new {
   my $class = shift;

   my $rand = join "", map chr 0x21 + rand 94, 1..40; # ~ 262 bits entropy

   my $self = bless {
      host       => $ENV{FREDHOST} || "127.0.0.1",
      port       => $ENV{FREDPORT} || 9481,
      timeout    => 3600 * 2,
      keepalive  => 9 * 60,
      name       => time.rand.rand.rand, # lame
      @_,
      queue      => [],
      req        => {},
      prefix     => "..:aefcpid:$rand:",
      idseq      => "a0",
   }, $class;

   {
      Scalar::Util::weaken (my $self = $self);

      $self->{kw} = AE::timer $self->{keepalive}, $self->{keepalive}, sub {
         $self->{hdl}->push_write ("\n");
      };

      our $ENDMESSAGE = qr<\012(EndMessage|Data)\012>;

      # these are declared here for performance reasons
      my ($k, $v, $type);
      my $rdata;
         
      my $on_read = sub {
         my ($hdl) = @_;

         # we only carve out whole messages here
         while ($hdl->{rbuf} =~ /\012(EndMessage|Data)\012/) {
            # remember end marker
            $rdata = $1 eq "Data"
               or $1 eq "EndMessage"
               or return $self->fatal ("protocol error, expected message end, got $1\n");

            my @lines = split /\012/, substr $hdl->{rbuf}, 0, $-[0];

            substr $hdl->{rbuf}, 0, $+[0], ""; # remove pkg

            $type = shift @lines;
            $type = ($TOLC{$type} ||= tolc $type);

            my %kv;

            for (@lines) {
               ($k, $v) = split /=/, $_, 2;
               $k = ($TOLC{$k} ||= tolc $k);
    
               if ($k =~ /\./) {
                  # generic, slow case
                  my @k = split /\./, $k;
                  my $ro = \\%kv;

                  while (@k) {
                     $k = shift @k;
                     if ($k =~ /^\d+$/) {
                        $ro = \$$ro->[$k];
                     } else {
                        $ro = \$$ro->{$k};
                     }
                  }

                  $$ro = $v;

                  next;
               }

               # special comon case, for performance only
               $kv{$k} = $v;
            }
    
            if ($rdata) {
               $_[0]->push_read (chunk => delete $kv{data_length}, sub {
                  $rdata = \$_[1];
                  $self->recv ($type, \%kv, $rdata);
               });

               last; # do not tgry to parse more messages
            } else {
               $self->recv ($type, \%kv);
            }
         }
      };

      $self->{hdl} = new AnyEvent::Handle
         connect  => [$self->{host} => $self->{port}],
         timeout  => $self->{timeout},
         on_read  => $on_read,
         on_eof   => sub {
            if ($self->{on_eof}) {
               $self->{on_eof}($self);
            } else {
               $self->fatal ("EOF");
            }
         },
         on_error => sub {
            $self->fatal ($_[2]);
         },
      ;

      Scalar::Util::weaken ($self->{hdl}{fcp} = $self);
   }

   $self->send_msg (client_hello =>
      name             => $self->{name},
      expected_version => "2.0",
   );

   $self
}

sub fatal {
   my ($self, $msg) = @_;

   $self->{hdl}->shutdown;
   delete $self->{kw};
   
   if ($self->{on_error}) {
      $self->{on_error}->($self, $msg);
   } else {
      die $msg;
   }
}

sub identifier {
   $_[0]{prefix} . ++$_[0]{idseq}
}

sub send_msg {
   my ($self, $type, %kv) = @_;

   my $data  = delete $kv{data};

   if (exists $kv{id_cb}) {
      my $id = $kv{identifier} ||= $self->identifier;
      $self->{id}{$id} = delete $kv{id_cb};
   }

   my $msg = (touc $type) . "\012"
             . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv;

      sub id {
         my ($self) = @_;


      }

   if (defined $data) {
      $msg .= "DataLength=" . (length $data) . "\012"
            . "Data\012$data";
   } else {
      $msg .= "EndMessage\012";
   }

   $self->{hdl}->push_write ($msg);
}

sub on {
   my ($self, $cb) = @_;

   # cb return undef - message eaten, remove cb

FCP.pm  view on Meta::CPAN

this order, e.g.:

   on_failure => sub {
      my ($fcp, $request_type, $backtrace, $orig_args, $error_object) = @_;

      warn "FCP failure ($type), $error_object->{code_description} ($error_object->{extra_description})$backtrace";
      exit 1;
   },

=item A condvar (as returned by e.g. C<< AnyEvent->condvar >>)

When a condvar is passed, it is sent (C<< $cv->send ($results) >>) the
results when the request has finished. Should an error occur, the error
will instead result in C<< $cv->croak ($error) >>.

This is also a popular choice.

=item An array with two callbacks C<[$success, $failure]>

The C<$success> callback will be invoked with the results, while the
C<$failure> callback will be invoked on any errors.

The C<$failure> callback will be invoked with the error object from the
server.

=item C<undef>

This is the same thing as specifying C<sub { }> as callback, i.e. on
success, the results are ignored, while on failure, the C<on_failure> hook
is invoked or the module dies with a backtrace.

This is good for quick scripts, or when you really aren't interested in
the results.

=back

=cut

our $NOP_CB = sub { };

sub _txn {
   my ($name, $sub) = @_;

   *{$name} = sub {
      my $cv = AE::cv;

      splice @_, 1, 0, $cv, sub { $cv->croak ($_[0]{extra_description}) };
      &$sub;
      $cv->recv
   };

   *{"$name\_"} = sub {
      my ($ok, $err) = pop;

      if (ARRAY:: eq ref $ok) {
         ($ok, $err) = @$ok;
      } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) {
         $err = sub { $ok->croak ($_[0]{extra_description}) };
      } else {
         my $bt = Carp::longmess "AnyEvent::FCP request $name";
         Scalar::Util::weaken (my $self = $_[0]);
         my $args = [@_]; shift @$args;
         $err = sub {
            if ($self->{on_failure}) {
               $self->{on_failure}($self, $name, $args, $bt, $_[0]);
            } else {
               die "$_[0]{code_description} ($_[0]{extra_description})$bt";
            }
         };
      }

      $ok ||= $NOP_CB;

      splice @_, 1, 0, $ok, $err;
      &$sub;
   };
}

=over 4

=item $peers = $fcp->list_peers ([$with_metdata[, $with_volatile]])

=cut

_txn list_peers => sub {
   my ($self, $ok, undef, $with_metadata, $with_volatile) = @_;

   my @res;

   $self->send_msg (list_peers =>
      with_metadata => $with_metadata ? "true" : "false",
      with_volatile => $with_volatile ? "true" : "false",
      id_cb         => sub {
         my ($self, $type, $kv, $rdata) = @_;

         if ($type eq "end_list_peers") {
            $ok->(\@res);
            1
         } else {
            push @res, $kv;
            0
         }
      },
   );
};

=item $notes = $fcp->list_peer_notes ($node_identifier)

=cut

_txn list_peer_notes => sub {
   my ($self, $ok, undef, $node_identifier) = @_;

   $self->send_msg (list_peer_notes =>
      node_identifier => $node_identifier,
      id_cb           => sub {
         my ($self, $type, $kv, $rdata) = @_;

         $ok->($kv);
         1
      },