Net-FCP/FCP.pm

=head1 NAME

Net::FCP - http://freenet.sf.net client protocol

=head1 SYNOPSIS

 use Net::FCP;

 my $fcp = new Net::FCP;

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

=head1 DESCRIPTION

See L<http://freenet.sourceforge.net/index.php?page=fcp> for a description
of what the messages do. I am too lazy to document all this here.

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

=head1 WARNING

This module is alpha. While it probably won't destroy (much :) of your
data, it currently falls short of what it should provide (intelligent uri
following, splitfile downloads, healing...)

=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.

=item Numbers are in HEX

Virtually every number in the FCP protocol is in hex. Be sure to use
C<hex()> on all such numbers, as the module (currently) does nothing to
convert these for you.

=back

=head2 THE Net::FCP CLASS

=over 4

=cut

package Net::FCP;

use Carp;

$VERSION = '1.0';

no warnings;

use AnyEvent;

use Net::FCP::Metadata;
use Net::FCP::Util qw(tolc touc xeh);

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

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

Connections are virtual because no persistent physical connection is
established.

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

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