view release on metacpan or  search on metacpan

FCP.pm  view on Meta::CPAN

use common::sense;

use Carp;

our $VERSION = 0.5;

use Scalar::Util ();

use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Util ();

our %TOLC; # tolc cache

sub touc($) {
   local $_ = shift;
   1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime|dda)(?:_|$))/\U$1/;
   s/(?:^|_)(.)/\U$1/g;
   $_
}

sub tolc($) {
   local $_ = shift;
   1 while s/(SVK|CHK|URI|FCP|DS|MIME|DDA)([^_])/$1\_$2/;
   1 while s/([^_])(SVK|CHK|URI|FCP|DS|MIME|DDA)/$1\_$2/;
   s/(?<=[a-z])(?=[A-Z])/_/g;
   lc
}

=item $fcp = new AnyEvent::FCP key => value...;

Create a new FCP connection to the given host and port (default
127.0.0.1:9481, or the environment variables C<FREDHOST> and C<FREDPORT>).

If no C<name> was specified, then AnyEvent::FCP will generate a
(hopefully) unique client name for you.

The following keys can be specified (they are all optional):

=over 4

=item name => $string

A unique name to identify this client. If none is specified, a randomly
generated name will be used.

=item host => $hostname

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);
               });