AnyEvent-FCP/FCP.pm

=head1 NAME

AnyEvent::FCP - freenet client protocol 2.0

=head1 SYNOPSIS

 use AnyEvent::FCP;

 my $fcp = new AnyEvent::FCP;

 my $ni = $fcp->txn_node_info->result;
 my $ni = $fcp->node_info;

=head1 DESCRIPTION

This module implements the freenet client protocol version 2.0, as used by
freenet 0.7. See L<Net::FCP> for the earlier freenet 0.5 version.

See L<http://wiki.freenetproject.org/FreenetFCPSpec2Point0> for a description
of what the messages do.

The module uses L<AnyEvent> to find a suitable event module.

=head2 IMPORT TAGS

Nothing much can be "imported" from this module right now.

=head2 FREENET BASICS

Ok, this section will not explain any freenet basics to you, just some
problems I found that you might want to avoid:

=over 4

=item freenet URIs are _NOT_ URIs

Whenever a "uri" is required by the protocol, freenet expects a kind of
URI prefixed with the "freenet:" scheme, e.g. "freenet:CHK...". However,
these are not URIs, as freeent fails to parse them correctly, that is, you
must unescape an escaped characters ("%2c" => ",") yourself. Maybe in the
future this library will do it for you, so watch out for this incompatible
change.

=back

=head2 THE AnyEvent::FCP CLASS

=over 4

=cut

package AnyEvent::FCP;

use Carp;

$VERSION = '0.1';

no warnings;

use AnyEvent;
use AnyEvent::Socket;

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

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

=item $fcp = new AnyEvent::FCP [host => $host][, port => $port][, progress => \&cb][, name => $name]

Create a new FCP connection to the given host and port (default
127.0.0.1:8481, 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.

#TODO
#You can install a progress callback that is being called with the Net::FCP
#object, a txn object, the type of the transaction and the attributes. Use
#it like this:
#
#   sub progress_cb {
#      my ($self, $txn, $type, $attr) = @_;
#
#      warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
#   }

=cut

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;

   $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
   $self->{port} ||= $ENV{FREDPORT} || 9481;
   $self->{name} ||= time.rand.rand.rand; # lame

   $self->{conn} = new AnyEvent::Socket
      PeerAddr => "$self->{host}:$self->{port}",
      on_eof   => $self->{on_eof} || sub { },

   $self
}

sub progress {
   my ($self, $txn, $type, $attr) = @_;

   $self->{progress}->($self, $txn, $type, $attr)
      if $self->{progress};
}

=item $txn = $fcp->txn (type => attr => val,...)

The low-level interface to transactions. Don't use it unless you have
"special needs". Instead, use predefiend transactions like this:

The blocking case, no (visible) transactions involved:

   my $nodehello = $fcp->client_hello;

A transaction used in a blocking fashion:
   
   my $txn = $fcp->txn_client_hello;
   ...
   my $nodehello = $txn->result;

Or shorter:

   my $nodehello = $fcp->txn_client_hello->result;

Setting callbacks:

   $fcp->txn_client_hello->cb(
      sub { my $nodehello => $_[0]->result }
   );

=cut

sub txn {
   my ($self, $type, %attr) = @_;

   $type = touc $type;

   my $txn = "Net::FCP::Txn::$type"->new (fcp => $self, type => tolc $type, attr => \%attr);

   $txn;
}

{ # transactions

my $txn = sub {
   my ($name, $sub) = @_;
   *{"txn_$name"} = $sub;
   *{$name} = sub { $sub->(@_)->result };
};

=item $txn = $fcp->txn_client_hello

=item $nodehello = $fcp->client_hello

Executes a ClientHello request and returns it's results.

   {
     max_file_size => "5f5e100",
     node => "Fred,0.6,1.46,7050"
     protocol => "1.2",
   }

=cut

$txn->(client_hello => sub {
   my ($self) = @_;

   $self->txn ("client_hello");
});

=item $txn = $fcp->txn_client_info

=item $nodeinfo = $fcp->client_info

Executes a ClientInfo request and returns it's results.

   {
     active_jobs => "1f",
     allocated_memory => "bde0000",
     architecture => "i386",
     available_threads => 17,
     datastore_free => "5ce03400",
     datastore_max => "2540be400",
     datastore_used => "1f72bb000",
     estimated_load => 52,
     free_memory => "5cc0148",
     is_transient => "false",
     java_name => "Java HotSpot(_T_M) Server VM",
     java_vendor => "http://www.blackdown.org/",
     java_version => "Blackdown-1.4.1-01",
     least_recent_timestamp => "f41538b878",
     max_file_size => "5f5e100",
     most_recent_timestamp => "f77e2cc520"
     node_address => "1.2.3.4",
     node_port => 369,
     operating_system => "Linux",
     operating_system_version => "2.4.20",
     routing_time => "a5",
   }

=cut

$txn->(client_info => sub {
   my ($self) = @_;

   $self->txn ("client_info");
});

=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])

=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])

Calculates a CHK, given the metadata and data. C<$cipher> is either
C<Rijndael> or C<Twofish>, with the latter being the default.

=cut

$txn->(generate_chk => sub {
   my ($self, $metadata, $data, $cipher) = @_;

   $metadata = Net::FCP::Metadata::build_metadata $metadata;

   $self->txn (generate_chk =>
               data => "$metadata$data",
               metadata_length => xeh length $metadata,
               cipher => $cipher || "Twofish");
});

=item $txn = $fcp->txn_generate_svk_pair

=item ($public, $private, $crypto) = @{ $fcp->generate_svk_pair }

Creates a new SVK pair. Returns an arrayref with the public key, the
private key and a crypto key, which is just additional entropy.

   [
     "acLx4dux9fvvABH15Gk6~d3I-yw",
     "cPoDkDMXDGSMM32plaPZDhJDxSs",
     "BH7LXCov0w51-y9i~BoB3g",
   ]

A private key (for inserting) can be constructed like this:

   SSK@<private_key>,<crypto_key>/<name>

It can be used to insert data. The corresponding public key looks like this:

   SSK@<public_key>PAgM,<crypto_key>/<name>

Watch out for the C<PAgM>-part!

=cut

$txn->(generate_svk_pair => sub {
   my ($self) = @_;

   $self->txn ("generate_svk_pair");
});

=item $txn = $fcp->txn_invert_private_key ($private)

=item $public = $fcp->invert_private_key ($private)

Inverts a private key (returns the public key). C<$private> can be either
an insert URI (must start with C<freenet:SSK@>) or a raw private key (i.e.
the private value you get back from C<generate_svk_pair>).

Returns the public key.

=cut

$txn->(invert_private_key => sub {
   my ($self, $privkey) = @_;

   $self->txn (invert_private_key => private => $privkey);
});

=item $txn = $fcp->txn_get_size ($uri)

=item $length = $fcp->get_size ($uri)

Finds and returns the size (rounded up to the nearest power of two) of the
given document.

=cut

$txn->(get_size => sub {
   my ($self, $uri) = @_;

   $self->txn (get_size => URI => $uri);
});

=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])

=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)

Fetches a (small, as it should fit into memory) key content block from
freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).

The C<$uri> should begin with C<freenet:>, but the scheme is currently
added, if missing.

  my ($meta, $data) = @{
     $fcp->client_get (
        "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
     )
  };

=cut

$txn->(client_get => sub {
   my ($self, $uri, $htl, $removelocal) = @_;

   $uri =~ s/^freenet://; $uri = "freenet:$uri";

   $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
               remove_local_key => $removelocal ? "true" : "false");
});

=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)

=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);

Insert a new key. If the client is inserting a CHK, the URI may be
abbreviated as just CHK@. In this case, the node will calculate the
CHK. If the key is a private SSK key, the node will calculcate the public
key and the resulting public URI.

C<$meta> can be a hash reference (same format as returned by
C<Net::FCP::parse_metadata>) or a string.

The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.

=cut

$txn->(client_put => sub {
   my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;

   $metadata = Net::FCP::Metadata::build_metadata $metadata;
   $uri =~ s/^freenet://; $uri = "freenet:$uri";

   $self->txn (client_put => URI => $uri,
               hops_to_live => xeh (defined $htl ? $htl : 15),
               remove_local_key => $removelocal ? "true" : "false",
               data => "$metadata$data", metadata_length => xeh length $metadata);
});

} # transactions

=back

=head2 THE Net::FCP::Txn CLASS

All requests (or transactions) are executed in a asynchronous way. For
each request, a C<Net::FCP::Txn> object is created (worse: a tcp
connection is created, too).

For each request there is actually a different subclass (and it's possible
to subclass these, although of course not documented).

The most interesting method is C<result>.

=over 4

=cut

package Net::FCP::Txn;

use Fcntl;
use Socket;

=item new arg => val,...

Creates a new C<Net::FCP::Txn> object. Not normally used.

=cut

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;

   $self->{signal} = AnyEvent->condvar;

   $self->{fcp}{txn}{$self} = $self;

   my $attr = "";
   my $data = delete $self->{attr}{data};

   while (my ($k, $v) = each %{$self->{attr}}) {
      $attr .= (Net::FCP::touc $k) . "=$v\012"
   }

   if (defined $data) {
      $attr .= sprintf "DataLength=%x\012", length $data;
      $data = "Data\012$data";
   } else {
      $data = "EndMessage\012";
   }

   socket my $fh, PF_INET, SOCK_STREAM, 0
      or Carp::croak "unable to create new tcp socket: $!";
   binmode $fh, ":raw";
   fcntl $fh, F_SETFL, O_NONBLOCK;
   connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host});
#      and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";

   $self->{sbuf} = 
      "\x00\x00\x00\x02"
      . (Net::FCP::touc $self->{type})
      . "\012$attr$data";

   #shutdown $fh, 1; # freenet buggy?, well, it's java...
   
   $self->{fh} = $fh;
   
   $self->{w} = AnyEvent->io (fh => $fh, poll => 'w', cb => sub { $self->fh_ready_w });
   
   $self;
}

=item $txn = $txn->cb ($coderef)

Sets a callback to be called when the request is finished. The coderef
will be called with the txn as it's sole argument, so it has to call
C<result> itself.

Returns the txn object, useful for chaining.

Example:

   $fcp->txn_client_get ("freenet:CHK....")
      ->userdata ("ehrm")
      ->cb(sub {
         my $data = shift->result;
      });

=cut

sub cb($$) {
   my ($self, $cb) = @_;
   $self->{cb} = $cb;
   $self;
}

=item $txn = $txn->userdata ([$userdata])

Set user-specific data. This is useful in progress callbacks. The data can be accessed
using C<< $txn->{userdata} >>.

Returns the txn object, useful for chaining.

=cut

sub userdata($$) {
   my ($self, $data) = @_;
   $self->{userdata} = $data;
   $self;
}

=item $txn->cancel (%attr)

Cancels the operation with a C<cancel> exception and the given attributes
(consider at least giving the attribute C<reason>).

UNTESTED.

=cut

sub cancel {
   my ($self, %attr) = @_;
   $self->throw (Net::FCP::Exception->new (cancel => { %attr }));
   $self->set_result;
   $self->eof;
}

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

   my $len = syswrite $self->{fh}, $self->{sbuf};

   if ($len > 0) {
      substr $self->{sbuf}, 0, $len, "";
      unless (length $self->{sbuf}) {
         fcntl $self->{fh}, F_SETFL, 0;
         $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub { $self->fh_ready_r });
      }
   } elsif (defined $len) {
      $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
   } else {
      $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
   }
}

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

   if (sysread $self->{fh}, $self->{buf}, 16384 + 1024, length $self->{buf}) {
      for (;;) {
         if ($self->{datalen}) {
            #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
            if (length $self->{buf} >= $self->{datalen}) {
               $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
            } else {
               last;
            }
         } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
            $self->{datalen} = hex $1;
            #warn "expecting new datachunk $self->{datalen}\n";#d#
         } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
            $self->rcv ($1, {
                  map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
                      split /\015?\012/, $2
            });
         } else {
            last;
         }
      }
   } else {
      $self->eof;
   }
}

sub rcv {
   my ($self, $type, $attr) = @_;

   $type = Net::FCP::tolc $type;

   #use PApp::Util; warn PApp::Util::dumpval [$type, $attr];

   if (my $method = $self->can("rcv_$type")) {
      $method->($self, $attr, $type);
   } else {
      warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
   }
}

# used as a default exception thrower
sub rcv_throw_exception {
   my ($self, $attr, $type) = @_;
   $self->throw (Net::FCP::Exception->new ($type, $attr));
}

*rcv_failed       = \&Net::FCP::Txn::rcv_throw_exception;
*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;

sub throw {
   my ($self, $exc) = @_;

   $self->{exception} = $exc;
   $self->set_result;
   $self->eof; # must be last to avoid loops
}

sub set_result {
   my ($self, $result) = @_;

   unless (exists $self->{result}) {
      $self->{result} = $result;
      $self->{cb}->($self) if exists $self->{cb};
      $self->{signal}->broadcast;
   }
}

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

   delete $self->{w};
   delete $self->{fh};

   delete $self->{fcp}{txn}{$self};

   unless (exists $self->{result}) {
      $self->throw (Net::FCP::Exception->new (short_data => {
         reason   => "unexpected eof or internal node error",
      }));
   }
}

sub progress {
   my ($self, $type, $attr) = @_;

   $self->{fcp}->progress ($self, $type, $attr);
}

=item $result = $txn->result

Waits until a result is available and then returns it.

This waiting is (depending on your event model) not very efficient, as it
is done outside the "mainloop". The biggest problem, however, is that it's
blocking one thread of execution. Try to use the callback mechanism, if
possible, and call result from within the callback (or after is has been
run), as then no waiting is necessary.

=cut

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

   $self->{signal}->wait while !exists $self->{result};

   die $self->{exception} if $self->{exception};

   return $self->{result};
}

package Net::FCP::Txn::ClientHello;

use base Net::FCP::Txn;

sub rcv_node_hello {
   my ($self, $attr) = @_;

   $self->set_result ($attr);
}

package Net::FCP::Txn::ClientInfo;

use base Net::FCP::Txn;

sub rcv_node_info {
   my ($self, $attr) = @_;

   $self->set_result ($attr);
}

package Net::FCP::Txn::GenerateCHK;

use base Net::FCP::Txn;

sub rcv_success {
   my ($self, $attr) = @_;

   $self->set_result ($attr->{uri});
}

package Net::FCP::Txn::GenerateSVKPair;

use base Net::FCP::Txn;

sub rcv_success {
   my ($self, $attr) = @_;
   $self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
}

package Net::FCP::Txn::InvertPrivateKey;

use base Net::FCP::Txn;

sub rcv_success {
   my ($self, $attr) = @_;
   $self->set_result ($attr->{public_key});
}

package Net::FCP::Txn::GetSize;

use base Net::FCP::Txn;

sub rcv_success {
   my ($self, $attr) = @_;
   $self->set_result (hex $attr->{length});
}

package Net::FCP::Txn::GetPut;

# base class for get and put

use base Net::FCP::Txn;

*rcv_uri_error       = \&Net::FCP::Txn::rcv_throw_exception;
*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;

sub rcv_restarted {
   my ($self, $attr, $type) = @_;

   delete $self->{datalength};
   delete $self->{metalength};
   delete $self->{data};

   $self->progress ($type, $attr);
}

package Net::FCP::Txn::ClientGet;

use base Net::FCP::Txn::GetPut;

*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;

sub rcv_data {
   my ($self, $chunk) = @_;

   $self->{data} .= $chunk;

   $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });

   if ($self->{datalength} == length $self->{data}) {
      my $data = delete $self->{data};
      my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");

      $self->set_result ([$meta, $data]);
      $self->eof;
   }
}

sub rcv_data_found {
   my ($self, $attr, $type) = @_;

   $self->progress ($type, $attr);

   $self->{datalength} = hex $attr->{data_length};
   $self->{metalength} = hex $attr->{metadata_length};
}

package Net::FCP::Txn::ClientPut;

use base Net::FCP::Txn::GetPut;

*rcv_size_error    = \&Net::FCP::Txn::rcv_throw_exception;

sub rcv_pending {
   my ($self, $attr, $type) = @_;
   $self->progress ($type, $attr);
}

sub rcv_success {
   my ($self, $attr, $type) = @_;
   $self->set_result ($attr);
}

sub rcv_key_collision {
   my ($self, $attr, $type) = @_;
   $self->set_result ({ key_collision => 1, %$attr });
}

=back

=head2 The Net::FCP::Exception CLASS

Any unexpected (non-standard) responses that make it impossible to return
the advertised result will result in an exception being thrown when the
C<result> method is called.

These exceptions are represented by objects of this class.

=over 4

=cut

package Net::FCP::Exception;

use overload
   '""' => sub {
      "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
   };

=item $exc = new Net::FCP::Exception $type, \%attr

Create a new exception object of the given type (a string like
C<route_not_found>), and a hashref containing additional attributes
(usually the attributes of the message causing the exception).

=cut

sub new {
   my ($class, $type, $attr) = @_;

   bless [Net::FCP::tolc $type, { %$attr }], $class;
}

=item $exc->type([$type])

With no arguments, returns the exception type. Otherwise a boolean
indicating wether the exception is of the given type is returned.

=cut

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

   @_ >= 2
      ? $self->[0] eq $type
      : $self->[0];
}

=item $exc->attr([$attr])

With no arguments, returns the attributes. Otherwise the named attribute
value is returned.

=cut

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

   @_ >= 2
      ? $self->[1]{$attr}
      : $self->[1];
}

=back

=head1 SEE ALSO

L<http://freenet.sf.net>.

=head1 BUGS

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

1

Revision:	1.1
Committed:	Sat Jul 18 05:57:59 2009 UTC (14 years, 10 months ago) by root
Branch:	MAIN
Log Message:	riddify us of meta.yml garbage in manifest
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::FCP - freenet client protocol 2.0
4
5			=head1 SYNOPSIS
6
7			use AnyEvent::FCP;
8
9			my $fcp = new AnyEvent::FCP;
10
11			my $ni = $fcp->txn_node_info->result;
12			my $ni = $fcp->node_info;
13
14			=head1 DESCRIPTION
15
16			This module implements the freenet client protocol version 2.0, as used by
17			freenet 0.7. See L<Net::FCP> for the earlier freenet 0.5 version.
18
19			See L<http://wiki.freenetproject.org/FreenetFCPSpec2Point0> for a description
20			of what the messages do.
21
22			The module uses L<AnyEvent> to find a suitable event module.
23
24			=head2 IMPORT TAGS
25
26			Nothing much can be "imported" from this module right now.
27
28			=head2 FREENET BASICS
29
30			Ok, this section will not explain any freenet basics to you, just some
31			problems I found that you might want to avoid:
32
33			=over 4
34
35			=item freenet URIs are _NOT_ URIs
36
37			Whenever a "uri" is required by the protocol, freenet expects a kind of
38			URI prefixed with the "freenet:" scheme, e.g. "freenet:CHK...". However,
39			these are not URIs, as freeent fails to parse them correctly, that is, you
40			must unescape an escaped characters ("%2c" => ",") yourself. Maybe in the
41			future this library will do it for you, so watch out for this incompatible
42			change.
43
44			=back
45
46			=head2 THE AnyEvent::FCP CLASS
47
48			=over 4
49
50			=cut
51
52			package AnyEvent::FCP;
53
54			use Carp;
55
56			$VERSION = '0.1';
57
58			no warnings;
59
60			use AnyEvent;
61			use AnyEvent::Socket;
62
63			sub touc($) {
64			local $_ = shift;
65			1 while s/((?:^\|_)(?:svk\|chk\|uri)(?:_\|$))/\U$1/;
66			s/(?:^\|_)(.)/\U$1/g;
67			$_
68			}
69
70			sub tolc($) {
71			local $_ = shift;
72			1 while s/(SVK\|CHK\|URI)([^_])/$1\_$2/i;
73			1 while s/([^_])(SVK\|CHK\|URI)/$1\_$2/i;
74			s/(?<=[a-z])(?=[A-Z])/_/g;
75			lc
76			}
77
78			=item $fcp = new AnyEvent::FCP [host => $host][, port => $port][, progress => \&cb][, name => $name]
79
80			Create a new FCP connection to the given host and port (default
81			127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
82
83			If no C<name> was specified, then AnyEvent::FCP will generate a (hopefully)
84			unique client name for you.
85
86			#TODO
87			#You can install a progress callback that is being called with the Net::FCP
88			#object, a txn object, the type of the transaction and the attributes. Use
89			#it like this:
90			#
91			# sub progress_cb {
92			# my ($self, $txn, $type, $attr) = @_;
93			#
94			# warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
95			# }
96
97			=cut
98
99			sub new {
100			my $class = shift;
101			my $self = bless { @_ }, $class;
102
103			$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";
104			$self->{port} \|\|= $ENV{FREDPORT} \|\| 9481;
105			$self->{name} \|\|= time.rand.rand.rand; # lame
106
107			$self->{conn} = new AnyEvent::Socket
108			PeerAddr => "$self->{host}:$self->{port}",
109			on_eof => $self->{on_eof} \|\| sub { },
110
111			$self
112			}
113
114			sub progress {
115			my ($self, $txn, $type, $attr) = @_;
116
117			$self->{progress}->($self, $txn, $type, $attr)
118			if $self->{progress};
119			}
120
121			=item $txn = $fcp->txn (type => attr => val,...)
122
123			The low-level interface to transactions. Don't use it unless you have
124			"special needs". Instead, use predefiend transactions like this:
125
126			The blocking case, no (visible) transactions involved:
127
128			my $nodehello = $fcp->client_hello;
129
130			A transaction used in a blocking fashion:
131
132			my $txn = $fcp->txn_client_hello;
133			...
134			my $nodehello = $txn->result;
135
136			Or shorter:
137
138			my $nodehello = $fcp->txn_client_hello->result;
139
140			Setting callbacks:
141
142			$fcp->txn_client_hello->cb(
143			sub { my $nodehello => $_[0]->result }
144			);
145
146			=cut
147
148			sub txn {
149			my ($self, $type, %attr) = @_;
150
151			$type = touc $type;
152
153			my $txn = "Net::FCP::Txn::$type"->new (fcp => $self, type => tolc $type, attr => \%attr);
154
155			$txn;
156			}
157
158			{ # transactions
159
160			my $txn = sub {
161			my ($name, $sub) = @_;
162			*{"txn_$name"} = $sub;
163			*{$name} = sub { $sub->(@_)->result };
164			};
165
166			=item $txn = $fcp->txn_client_hello
167
168			=item $nodehello = $fcp->client_hello
169
170			Executes a ClientHello request and returns it's results.
171
172			{
173			max_file_size => "5f5e100",
174			node => "Fred,0.6,1.46,7050"
175			protocol => "1.2",
176			}
177
178			=cut
179
180			$txn->(client_hello => sub {
181			my ($self) = @_;
182
183			$self->txn ("client_hello");
184			});
185
186			=item $txn = $fcp->txn_client_info
187
188			=item $nodeinfo = $fcp->client_info
189
190			Executes a ClientInfo request and returns it's results.
191
192			{
193			active_jobs => "1f",
194			allocated_memory => "bde0000",
195			architecture => "i386",
196			available_threads => 17,
197			datastore_free => "5ce03400",
198			datastore_max => "2540be400",
199			datastore_used => "1f72bb000",
200			estimated_load => 52,
201			free_memory => "5cc0148",
202			is_transient => "false",
203			java_name => "Java HotSpot(_T_M) Server VM",
204			java_vendor => "http://www.blackdown.org/",
205			java_version => "Blackdown-1.4.1-01",
206			least_recent_timestamp => "f41538b878",
207			max_file_size => "5f5e100",
208			most_recent_timestamp => "f77e2cc520"
209			node_address => "1.2.3.4",
210			node_port => 369,
211			operating_system => "Linux",
212			operating_system_version => "2.4.20",
213			routing_time => "a5",
214			}
215
216			=cut
217
218			$txn->(client_info => sub {
219			my ($self) = @_;
220
221			$self->txn ("client_info");
222			});
223
224			=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
225
226			=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
227
228			Calculates a CHK, given the metadata and data. C<$cipher> is either
229			C<Rijndael> or C<Twofish>, with the latter being the default.
230
231			=cut
232
233			$txn->(generate_chk => sub {
234			my ($self, $metadata, $data, $cipher) = @_;
235
236			$metadata = Net::FCP::Metadata::build_metadata $metadata;
237
238			$self->txn (generate_chk =>
239			data => "$metadata$data",
240			metadata_length => xeh length $metadata,
241			cipher => $cipher \|\| "Twofish");
242			});
243
244			=item $txn = $fcp->txn_generate_svk_pair
245
246			=item ($public, $private, $crypto) = @{ $fcp->generate_svk_pair }
247
248			Creates a new SVK pair. Returns an arrayref with the public key, the
249			private key and a crypto key, which is just additional entropy.
250
251			[
252			"acLx4dux9fvvABH15Gk6~d3I-yw",
253			"cPoDkDMXDGSMM32plaPZDhJDxSs",
254			"BH7LXCov0w51-y9i~BoB3g",
255			]
256
257			A private key (for inserting) can be constructed like this:
258
259			SSK@<private_key>,<crypto_key>/<name>
260
261			It can be used to insert data. The corresponding public key looks like this:
262
263			SSK@<public_key>PAgM,<crypto_key>/<name>
264
265			Watch out for the C<PAgM>-part!
266
267			=cut
268
269			$txn->(generate_svk_pair => sub {
270			my ($self) = @_;
271
272			$self->txn ("generate_svk_pair");
273			});
274
275			=item $txn = $fcp->txn_invert_private_key ($private)
276
277			=item $public = $fcp->invert_private_key ($private)
278
279			Inverts a private key (returns the public key). C<$private> can be either
280			an insert URI (must start with C<freenet:SSK@>) or a raw private key (i.e.
281			the private value you get back from C<generate_svk_pair>).
282
283			Returns the public key.
284
285			=cut
286
287			$txn->(invert_private_key => sub {
288			my ($self, $privkey) = @_;
289
290			$self->txn (invert_private_key => private => $privkey);
291			});
292
293			=item $txn = $fcp->txn_get_size ($uri)
294
295			=item $length = $fcp->get_size ($uri)
296
297			Finds and returns the size (rounded up to the nearest power of two) of the
298			given document.
299
300			=cut
301
302			$txn->(get_size => sub {
303			my ($self, $uri) = @_;
304
305			$self->txn (get_size => URI => $uri);
306			});
307
308			=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
309
310			=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
311
312			Fetches a (small, as it should fit into memory) key content block from
313			freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).
314
315			The C<$uri> should begin with C<freenet:>, but the scheme is currently
316			added, if missing.
317
318			my ($meta, $data) = @{
319			$fcp->client_get (
320			"freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
321			)
322			};
323
324			=cut
325
326			$txn->(client_get => sub {
327			my ($self, $uri, $htl, $removelocal) = @_;
328
329			$uri =~ s/^freenet://; $uri = "freenet:$uri";
330
331			$self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
332			remove_local_key => $removelocal ? "true" : "false");
333			});
334
335			=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
336
337			=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);
338
339			Insert a new key. If the client is inserting a CHK, the URI may be
340			abbreviated as just CHK@. In this case, the node will calculate the
341			CHK. If the key is a private SSK key, the node will calculcate the public
342			key and the resulting public URI.
343
344			C<$meta> can be a hash reference (same format as returned by
345			C<Net::FCP::parse_metadata>) or a string.
346
347			The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
348
349			=cut
350
351			$txn->(client_put => sub {
352			my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
353
354			$metadata = Net::FCP::Metadata::build_metadata $metadata;
355			$uri =~ s/^freenet://; $uri = "freenet:$uri";
356
357			$self->txn (client_put => URI => $uri,
358			hops_to_live => xeh (defined $htl ? $htl : 15),
359			remove_local_key => $removelocal ? "true" : "false",
360			data => "$metadata$data", metadata_length => xeh length $metadata);
361			});
362
363			} # transactions
364
365			=back
366
367			=head2 THE Net::FCP::Txn CLASS
368
369			All requests (or transactions) are executed in a asynchronous way. For
370			each request, a C<Net::FCP::Txn> object is created (worse: a tcp
371			connection is created, too).
372
373			For each request there is actually a different subclass (and it's possible
374			to subclass these, although of course not documented).
375
376			The most interesting method is C<result>.
377
378			=over 4
379
380			=cut
381
382			package Net::FCP::Txn;
383
384			use Fcntl;
385			use Socket;
386
387			=item new arg => val,...
388
389			Creates a new C<Net::FCP::Txn> object. Not normally used.
390
391			=cut
392
393			sub new {
394			my $class = shift;
395			my $self = bless { @_ }, $class;
396
397			$self->{signal} = AnyEvent->condvar;
398
399			$self->{fcp}{txn}{$self} = $self;
400
401			my $attr = "";
402			my $data = delete $self->{attr}{data};
403
404			while (my ($k, $v) = each %{$self->{attr}}) {
405			$attr .= (Net::FCP::touc $k) . "=$v\012"
406			}
407
408			if (defined $data) {
409			$attr .= sprintf "DataLength=%x\012", length $data;
410			$data = "Data\012$data";
411			} else {
412			$data = "EndMessage\012";
413			}
414
415			socket my $fh, PF_INET, SOCK_STREAM, 0
416			or Carp::croak "unable to create new tcp socket: $!";
417			binmode $fh, ":raw";
418			fcntl $fh, F_SETFL, O_NONBLOCK;
419			connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host});
420			# and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
421
422			$self->{sbuf} =
423			"\x00\x00\x00\x02"
424			. (Net::FCP::touc $self->{type})
425			. "\012$attr$data";
426
427			#shutdown $fh, 1; # freenet buggy?, well, it's java...
428
429			$self->{fh} = $fh;
430
431			$self->{w} = AnyEvent->io (fh => $fh, poll => 'w', cb => sub { $self->fh_ready_w });
432
433			$self;
434			}
435
436			=item $txn = $txn->cb ($coderef)
437
438			Sets a callback to be called when the request is finished. The coderef
439			will be called with the txn as it's sole argument, so it has to call
440			C<result> itself.
441
442			Returns the txn object, useful for chaining.
443
444			Example:
445
446			$fcp->txn_client_get ("freenet:CHK....")
447			->userdata ("ehrm")
448			->cb(sub {
449			my $data = shift->result;
450			});
451
452			=cut
453
454			sub cb($$) {
455			my ($self, $cb) = @_;
456			$self->{cb} = $cb;
457			$self;
458			}
459
460			=item $txn = $txn->userdata ([$userdata])
461
462			Set user-specific data. This is useful in progress callbacks. The data can be accessed
463			using C<< $txn->{userdata} >>.
464
465			Returns the txn object, useful for chaining.
466
467			=cut
468
469			sub userdata($$) {
470			my ($self, $data) = @_;
471			$self->{userdata} = $data;
472			$self;
473			}
474
475			=item $txn->cancel (%attr)
476
477			Cancels the operation with a C<cancel> exception and the given attributes
478			(consider at least giving the attribute C<reason>).
479
480			UNTESTED.
481
482			=cut
483
484			sub cancel {
485			my ($self, %attr) = @_;
486			$self->throw (Net::FCP::Exception->new (cancel => { %attr }));
487			$self->set_result;
488			$self->eof;
489			}
490
491			sub fh_ready_w {
492			my ($self) = @_;
493
494			my $len = syswrite $self->{fh}, $self->{sbuf};
495
496			if ($len > 0) {
497			substr $self->{sbuf}, 0, $len, "";
498			unless (length $self->{sbuf}) {
499			fcntl $self->{fh}, F_SETFL, 0;
500			$self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub { $self->fh_ready_r });
501			}
502			} elsif (defined $len) {
503			$self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
504			} else {
505			$self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
506			}
507			}
508
509			sub fh_ready_r {
510			my ($self) = @_;
511
512			if (sysread $self->{fh}, $self->{buf}, 16384 + 1024, length $self->{buf}) {
513			for (;;) {
514			if ($self->{datalen}) {
515			#warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
516			if (length $self->{buf} >= $self->{datalen}) {
517			$self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
518			} else {
519			last;
520			}
521			} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
522			$self->{datalen} = hex $1;
523			#warn "expecting new datachunk $self->{datalen}\n";#d#
524			} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
525			$self->rcv ($1, {
526			map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
527			split /\015?\012/, $2
528			});
529			} else {
530			last;
531			}
532			}
533			} else {
534			$self->eof;
535			}
536			}
537
538			sub rcv {
539			my ($self, $type, $attr) = @_;
540
541			$type = Net::FCP::tolc $type;
542
543			#use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
544
545			if (my $method = $self->can("rcv_$type")) {
546			$method->($self, $attr, $type);
547			} else {
548			warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
549			}
550			}
551
552			# used as a default exception thrower
553			sub rcv_throw_exception {
554			my ($self, $attr, $type) = @_;
555			$self->throw (Net::FCP::Exception->new ($type, $attr));
556			}
557
558			*rcv_failed = \&Net::FCP::Txn::rcv_throw_exception;
559			*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;
560
561			sub throw {
562			my ($self, $exc) = @_;
563
564			$self->{exception} = $exc;
565			$self->set_result;
566			$self->eof; # must be last to avoid loops
567			}
568
569			sub set_result {
570			my ($self, $result) = @_;
571
572			unless (exists $self->{result}) {
573			$self->{result} = $result;
574			$self->{cb}->($self) if exists $self->{cb};
575			$self->{signal}->broadcast;
576			}
577			}
578
579			sub eof {
580			my ($self) = @_;
581
582			delete $self->{w};
583			delete $self->{fh};
584
585			delete $self->{fcp}{txn}{$self};
586
587			unless (exists $self->{result}) {
588			$self->throw (Net::FCP::Exception->new (short_data => {
589			reason => "unexpected eof or internal node error",
590			}));
591			}
592			}
593
594			sub progress {
595			my ($self, $type, $attr) = @_;
596
597			$self->{fcp}->progress ($self, $type, $attr);
598			}
599
600			=item $result = $txn->result
601
602			Waits until a result is available and then returns it.
603
604			This waiting is (depending on your event model) not very efficient, as it
605			is done outside the "mainloop". The biggest problem, however, is that it's
606			blocking one thread of execution. Try to use the callback mechanism, if
607			possible, and call result from within the callback (or after is has been
608			run), as then no waiting is necessary.
609
610			=cut
611
612			sub result {
613			my ($self) = @_;
614
615			$self->{signal}->wait while !exists $self->{result};
616
617			die $self->{exception} if $self->{exception};
618
619			return $self->{result};
620			}
621
622			package Net::FCP::Txn::ClientHello;
623
624			use base Net::FCP::Txn;
625
626			sub rcv_node_hello {
627			my ($self, $attr) = @_;
628
629			$self->set_result ($attr);
630			}
631
632			package Net::FCP::Txn::ClientInfo;
633
634			use base Net::FCP::Txn;
635
636			sub rcv_node_info {
637			my ($self, $attr) = @_;
638
639			$self->set_result ($attr);
640			}
641
642			package Net::FCP::Txn::GenerateCHK;
643
644			use base Net::FCP::Txn;
645
646			sub rcv_success {
647			my ($self, $attr) = @_;
648
649			$self->set_result ($attr->{uri});
650			}
651
652			package Net::FCP::Txn::GenerateSVKPair;
653
654			use base Net::FCP::Txn;
655
656			sub rcv_success {
657			my ($self, $attr) = @_;
658			$self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
659			}
660
661			package Net::FCP::Txn::InvertPrivateKey;
662
663			use base Net::FCP::Txn;
664
665			sub rcv_success {
666			my ($self, $attr) = @_;
667			$self->set_result ($attr->{public_key});
668			}
669
670			package Net::FCP::Txn::GetSize;
671
672			use base Net::FCP::Txn;
673
674			sub rcv_success {
675			my ($self, $attr) = @_;
676			$self->set_result (hex $attr->{length});
677			}
678
679			package Net::FCP::Txn::GetPut;
680
681			# base class for get and put
682
683			use base Net::FCP::Txn;
684
685			*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
686			*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
687
688			sub rcv_restarted {
689			my ($self, $attr, $type) = @_;
690
691			delete $self->{datalength};
692			delete $self->{metalength};
693			delete $self->{data};
694
695			$self->progress ($type, $attr);
696			}
697
698			package Net::FCP::Txn::ClientGet;
699
700			use base Net::FCP::Txn::GetPut;
701
702			*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;
703
704			sub rcv_data {
705			my ($self, $chunk) = @_;
706
707			$self->{data} .= $chunk;
708
709			$self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
710
711			if ($self->{datalength} == length $self->{data}) {
712			my $data = delete $self->{data};
713			my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
714
715			$self->set_result ([$meta, $data]);
716			$self->eof;
717			}
718			}
719
720			sub rcv_data_found {
721			my ($self, $attr, $type) = @_;
722
723			$self->progress ($type, $attr);
724
725			$self->{datalength} = hex $attr->{data_length};
726			$self->{metalength} = hex $attr->{metadata_length};
727			}
728
729			package Net::FCP::Txn::ClientPut;
730
731			use base Net::FCP::Txn::GetPut;
732
733			*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
734
735			sub rcv_pending {
736			my ($self, $attr, $type) = @_;
737			$self->progress ($type, $attr);
738			}
739
740			sub rcv_success {
741			my ($self, $attr, $type) = @_;
742			$self->set_result ($attr);
743			}
744
745			sub rcv_key_collision {
746			my ($self, $attr, $type) = @_;
747			$self->set_result ({ key_collision => 1, %$attr });
748			}
749
750			=back
751
752			=head2 The Net::FCP::Exception CLASS
753
754			Any unexpected (non-standard) responses that make it impossible to return
755			the advertised result will result in an exception being thrown when the
756			C<result> method is called.
757
758			These exceptions are represented by objects of this class.
759
760			=over 4
761
762			=cut
763
764			package Net::FCP::Exception;
765
766			use overload
767			'""' => sub {
768			"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
769			};
770
771			=item $exc = new Net::FCP::Exception $type, \%attr
772
773			Create a new exception object of the given type (a string like
774			C<route_not_found>), and a hashref containing additional attributes
775			(usually the attributes of the message causing the exception).
776
777			=cut
778
779			sub new {
780			my ($class, $type, $attr) = @_;
781
782			bless [Net::FCP::tolc $type, { %$attr }], $class;
783			}
784
785			=item $exc->type([$type])
786
787			With no arguments, returns the exception type. Otherwise a boolean
788			indicating wether the exception is of the given type is returned.
789
790			=cut
791
792			sub type {
793			my ($self, $type) = @_;
794
795			@_ >= 2
796			? $self->[0] eq $type
797			: $self->[0];
798			}
799
800			=item $exc->attr([$attr])
801
802			With no arguments, returns the attributes. Otherwise the named attribute
803			value is returned.
804
805			=cut
806
807			sub attr {
808			my ($self, $attr) = @_;
809
810			@_ >= 2
811			? $self->[1]{$attr}
812			: $self->[1];
813			}
814
815			=back
816
817			=head1 SEE ALSO
818
819			L<http://freenet.sf.net>.
820
821			=head1 BUGS
822
823			=head1 AUTHOR
824
825			Marc Lehmann <schmorp@schmorp.de>
826			http://home.schmorp.de/
827
828			=cut
829
830			1
831