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

This module implements the first version of the freenet client protocol,
for use with freenet versions 0.5. For freenet protocol version 2.0
support (as used by freenet 0.7), see the L<AnyEvent::FCP> module.

See L<http://freenet.sourceforge.net/index.php?page=fcp> 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.

=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.2';

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