cvsroot/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.

=head1 WARNING

This module is alpha. While it probably won't destroy (much :) of your
data, it currently works only with the Event module (alkthough the event
mechanism is fully pluggable).

=head2 THE Net::FCP CLASS

=over 4

=cut

package Net::FCP;

use Carp;
use IO::Socket::INET;

$VERSION = 0.03;

sub event_reg_cb {
   my ($obj) = @_;
   require Event;

   $obj->{eventdata} = Event->io (
      fd   => $obj->{fh},
      poll => 'r',
      cb   => sub {
         $obj->fh_ready;
      },
   );
}

sub event_unreg_cb {
   $_[0]{eventdata}
      and (delete $_[0]{eventdata})->cancel;
}

sub event_wait_cb {
   Event::one_event();
}

$regcb = \&event_reg_cb;
$unregcb = \&event_unreg_cb;
$waitcb = \&event_wait_cb;

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

sub tolc($) {
   local $_ = shift;
   s/(?<=[a-z])(?=[A-Z])/_/g;
   lc $_;
}

=item $fcp = new Net::FCP [host => $host][, port => $port]

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. However, the existance of the node is checked by executing a
C<ClientHello> transaction.

=cut

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

   $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
   $self->{port} ||= $ENV{FREDPORt} || 8481;

   $self->{nodehello} = $self->client_hello
      or croak "unable to get nodehello from node\n";

   $self;
}

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

The low-level interface to transactions. Don't use it.

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

sub _txn($&) {
   my ($name, $sub) = @_;
   *{"$name\_txn"} = $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)

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

Creates a new CHK, given the metadata and data. UNTESTED.

=cut

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

   $self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata);
};

=item $txn = $fcp->txn_generate_svk_pair

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

Creates a new SVK pair. Returns an arrayref.

   [
     "hKs0-WDQA4pVZyMPKNFsK1zapWY",
     "ZnmvMITaTXBMFGl4~jrjuyWxOWg"
   ]

=cut

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

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

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

=item $uri = $fcp->insert_private_key ($private)

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

Returns the public key.

UNTESTED.

=cut

_txn insert_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.

UNTESTED.

=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 ($data, $metadata) = @{ $fcp->client_get ($uri, $htl, $removelocal)

Fetches a (small, as it should fit into memory) file from freenet.

Due to the overhead, a better method to download big fiels should be used.

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

=cut

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

   $self->txn (client_get => URI => $uri, hops_to_live => ($htl || 15), remove_local => $removelocal*1);
};

=item MISSING: ClientPut

=back

=head2 THE Net::FCP::Txn CLASS

All requests (or transactions) are executed in a asynchroneous way (LIE:
uploads are blocking). 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;

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

   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 .= "DataLength=" . (length $data) . "\012";
      $data = "Data\012$data";
   } else {
      $data = "EndMessage\012";
   }

   my $fh = new IO::Socket::INET
      PeerHost => $self->{fcp}{host},
      PeerPort => $self->{fcp}{port}
      or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";

   binmode $fh, ":raw";

   if (0) {
      print
         Net::FCP::touc $self->{type}, "\012",
         $attr,
         $data, "\012";
   }

   print $fh
      "\x00\x00", "\x00\x02", # SESSID, PRESID
      Net::FCP::touc $self->{type}, "\012",
      $attr,
      $data;

   #$fh->shutdown (1); # freenet buggy?, well, it's java...
   
   $self->{fh} = $fh;
   
   $Net::FCP::regcb->($self);
   
   $self;
}

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

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

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

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

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

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

   $self->{result} = $result unless exists $self->{result};
}

sub eof {
   my ($self) = @_;
   $self->set_result;
}

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

=cut

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

   $Net::FCP::waitcb->() while !exists $self->{result};

   return $self->{result};
}

sub DESTROY {
   $Net::FCP::unregcb->($_[0]);
}

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

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

use base Net::FCP::Txn;

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

   $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
}

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

use base Net::FCP::Txn;

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

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

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

use base Net::FCP::Txn;

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

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

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

use base Net::FCP::Txn;

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

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

sub eof {
   my ($self) = @_;
   #use PApp::Util; warn PApp::Util::dumpval $self;
   my $data = delete $self->{data};
   $self->set_result ([
      (substr $data, 0, $self->{datalength}-$self->{metalength}),
      (substr $data, $self->{datalength}-$self->{metalength}),
   ]);
}

=back

=head1 SEE ALSO

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

=head1 BUGS

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

1;

Revision:	1.6
Committed:	Mon Sep 8 00:36:44 2003 UTC (20 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.5:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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			=head1 WARNING
20
21			This module is alpha. While it probably won't destroy (much :) of your
22			data, it currently works only with the Event module (alkthough the event
23			mechanism is fully pluggable).
24
25			=head2 THE Net::FCP CLASS
26
27			=over 4
28
29			=cut
30
31			package Net::FCP;
32
33			use Carp;
34			use IO::Socket::INET;
35
36	root	1.6	$VERSION = 0.03;
37	root	1.1
38			sub event_reg_cb {
39			my ($obj) = @_;
40			require Event;
41
42			$obj->{eventdata} = Event->io (
43			fd => $obj->{fh},
44			poll => 'r',
45			cb => sub {
46			$obj->fh_ready;
47			},
48			);
49			}
50
51			sub event_unreg_cb {
52			$_[0]{eventdata}
53			and (delete $_[0]{eventdata})->cancel;
54			}
55
56			sub event_wait_cb {
57			Event::one_event();
58			}
59
60			$regcb = \&event_reg_cb;
61			$unregcb = \&event_unreg_cb;
62			$waitcb = \&event_wait_cb;
63
64	root	1.2	sub touc($) {
65			local $_ = shift;
66			1 while s/((?:^\|_)(?:svk\|chk\|uri)(?:_\|$))/\U$1/;
67			s/(?:^\|_)(.)/\U$1/g;
68			$_;
69			}
70
71			sub tolc($) {
72			local $_ = shift;
73			s/(?<=[a-z])(?=[A-Z])/_/g;
74			lc $_;
75			}
76
77	root	1.1	=item $fcp = new Net::FCP [host => $host][, port => $port]
78
79			Create a new virtual FCP connection to the given host and port (default
80	root	1.5	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
81	root	1.1
82			Connections are virtual because no persistent physical connection is
83			established. However, the existance of the node is checked by executing a
84			C<ClientHello> transaction.
85
86			=cut
87
88			sub new {
89			my $class = shift;
90			my $self = bless { @_ }, $class;
91
92	root	1.5	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";
93			$self->{port} \|\|= $ENV{FREDPORt} \|\| 8481;
94	root	1.1
95	root	1.5	$self->{nodehello} = $self->client_hello
96	root	1.1	or croak "unable to get nodehello from node\n";
97
98			$self;
99			}
100
101			=item $txn = $fcp->txn(type => attr => val,...)
102
103			The low-level interface to transactions. Don't use it.
104
105			=cut
106
107			sub txn {
108			my ($self, $type, %attr) = @_;
109
110	root	1.2	$type = touc $type;
111
112			my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
113	root	1.1
114			$txn;
115			}
116
117			sub _txn($&) {
118			my ($name, $sub) = @_;
119			*{"$name\_txn"} = $sub;
120			*{$name} = sub { $sub->(@_)->result };
121			}
122
123			=item $txn = $fcp->txn_client_hello
124
125			=item $nodehello = $fcp->client_hello
126
127			Executes a ClientHello request and returns it's results.
128
129			{
130	root	1.2	max_file_size => "5f5e100",
131	root	1.4	node => "Fred,0.6,1.46,7050"
132	root	1.2	protocol => "1.2",
133	root	1.1	}
134
135			=cut
136
137			_txn client_hello => sub {
138			my ($self) = @_;
139
140	root	1.2	$self->txn ("client_hello");
141	root	1.1	};
142
143			=item $txn = $fcp->txn_client_info
144
145			=item $nodeinfo = $fcp->client_info
146
147			Executes a ClientInfo request and returns it's results.
148
149			{
150	root	1.2	active_jobs => "1f",
151			allocated_memory => "bde0000",
152			architecture => "i386",
153			available_threads => 17,
154	root	1.4	datastore_free => "5ce03400",
155			datastore_max => "2540be400",
156	root	1.2	datastore_used => "1f72bb000",
157	root	1.4	estimated_load => 52,
158			free_memory => "5cc0148",
159	root	1.2	is_transient => "false",
160	root	1.4	java_name => "Java HotSpot(_T_M) Server VM",
161	root	1.2	java_vendor => "http://www.blackdown.org/",
162	root	1.4	java_version => "Blackdown-1.4.1-01",
163			least_recent_timestamp => "f41538b878",
164			max_file_size => "5f5e100",
165	root	1.2	most_recent_timestamp => "f77e2cc520"
166	root	1.4	node_address => "1.2.3.4",
167			node_port => 369,
168			operating_system => "Linux",
169			operating_system_version => "2.4.20",
170			routing_time => "a5",
171	root	1.1	}
172
173			=cut
174
175			_txn client_info => sub {
176			my ($self) = @_;
177
178	root	1.2	$self->txn ("client_info");
179	root	1.1	};
180
181			=item $txn = $fcp->txn_generate_chk ($metadata, $data)
182
183			=item $uri = $fcp->generate_chk ($metadata, $data)
184
185			Creates a new CHK, given the metadata and data. UNTESTED.
186
187			=cut
188
189			_txn generate_chk => sub {
190			my ($self, $metadata, $data) = @_;
191
192	root	1.2	$self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata);
193	root	1.1	};
194
195			=item $txn = $fcp->txn_generate_svk_pair
196
197			=item ($public, $private) = @{ $fcp->generate_svk_pair }
198
199			Creates a new SVK pair. Returns an arrayref.
200
201			[
202			"hKs0-WDQA4pVZyMPKNFsK1zapWY",
203			"ZnmvMITaTXBMFGl4~jrjuyWxOWg"
204			]
205
206			=cut
207
208			_txn generate_svk_pair => sub {
209			my ($self) = @_;
210
211	root	1.2	$self->txn ("generate_svk_pair");
212	root	1.1	};
213
214			=item $txn = $fcp->txn_insert_private_key ($private)
215
216			=item $uri = $fcp->insert_private_key ($private)
217
218			Inserts a private key. $private can be either an insert URI (must start
219			with freenet:SSK@) or a raw private key (i.e. the private value you get back
220			from C<generate_svk_pair>).
221
222			Returns the public key.
223
224			UNTESTED.
225
226			=cut
227
228			_txn insert_private_key => sub {
229			my ($self, $privkey) = @_;
230
231	root	1.2	$self->txn (invert_private_key => private => $privkey);
232	root	1.1	};
233
234			=item $txn = $fcp->txn_get_size ($uri)
235
236			=item $length = $fcp->get_size ($uri)
237
238			Finds and returns the size (rounded up to the nearest power of two) of the
239			given document.
240
241			UNTESTED.
242
243			=cut
244
245			_txn get_size => sub {
246			my ($self, $uri) = @_;
247
248	root	1.2	$self->txn (get_size => URI => $uri);
249	root	1.1	};
250
251	root	1.5	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
252
253			=item ($data, $metadata) = @{ $fcp->client_get ($uri, $htl, $removelocal)
254
255			Fetches a (small, as it should fit into memory) file from freenet.
256
257			Due to the overhead, a better method to download big fiels should be used.
258
259			my ($data, $meta) = @{
260			$fcp->client_get (
261			"freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
262			)
263			};
264
265			=cut
266
267			_txn client_get => sub {
268			my ($self, $uri, $htl, $removelocal) = @_;
269
270			$self->txn (client_get => URI => $uri, hops_to_live => ($htl \|\| 15), remove_local => $removelocal*1);
271			};
272
273			=item MISSING: ClientPut
274	root	1.1
275			=back
276
277			=head2 THE Net::FCP::Txn CLASS
278
279			All requests (or transactions) are executed in a asynchroneous way (LIE:
280			uploads are blocking). For each request, a C<Net::FCP::Txn> object is
281			created (worse: a tcp connection is created, too).
282
283			For each request there is actually a different subclass (and it's possible
284			to subclass these, although of course not documented).
285
286			The most interesting method is C<result>.
287
288			=over 4
289
290			=cut
291
292			package Net::FCP::Txn;
293
294			=item new arg => val,...
295
296			Creates a new C<Net::FCP::Txn> object. Not normally used.
297
298			=cut
299
300			sub new {
301			my $class = shift;
302			my $self = bless { @_ }, $class;
303
304			my $attr = "";
305			my $data = delete $self->{attr}{data};
306
307			while (my ($k, $v) = each %{$self->{attr}}) {
308	root	1.2	$attr .= (Net::FCP::touc $k) . "=$v\012"
309	root	1.1	}
310
311			if (defined $data) {
312			$attr .= "DataLength=" . (length $data) . "\012";
313			$data = "Data\012$data";
314			} else {
315			$data = "EndMessage\012";
316			}
317
318			my $fh = new IO::Socket::INET
319			PeerHost => $self->{fcp}{host},
320			PeerPort => $self->{fcp}{port}
321			or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
322
323			binmode $fh, ":raw";
324
325	root	1.2	if (0) {
326			print
327			Net::FCP::touc $self->{type}, "\012",
328			$attr,
329			$data, "\012";
330			}
331	root	1.1
332			print $fh
333			"\x00\x00", "\x00\x02", # SESSID, PRESID
334	root	1.2	Net::FCP::touc $self->{type}, "\012",
335	root	1.1	$attr,
336			$data;
337
338			#$fh->shutdown (1); # freenet buggy?, well, it's java...
339
340			$self->{fh} = $fh;
341
342			$Net::FCP::regcb->($self);
343
344			$self;
345			}
346
347			sub fh_ready {
348			my ($self) = @_;
349
350			if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
351			for (;;) {
352			if ($self->{datalen}) {
353			if (length $self->{buf} >= $self->{datalen}) {
354	root	1.5	$self->rcv_data (substr $self->{buf}, 0, $self->{datalen}, "");
355	root	1.1	} else {
356			last;
357			}
358	root	1.5	} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
359			$self->{datalen} = hex $1;
360	root	1.1	} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) {
361	root	1.2	$self->rcv ($1, {
362			map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
363			split /\015?\012/, $2
364			});
365	root	1.1	} else {
366			last;
367			}
368			}
369			} else {
370			$Net::FCP::unregcb->($self);
371			delete $self->{fh};
372			$self->eof;
373			}
374			}
375
376			sub rcv_data {
377			my ($self, $chunk) = @_;
378	root	1.5
379			$self->{data} .= $chunk;
380	root	1.1	}
381
382			sub rcv {
383			my ($self, $type, $attr) = @_;
384
385	root	1.2	$type = Net::FCP::tolc $type;
386
387	root	1.5	#use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
388
389	root	1.2	if (my $method = $self->can("rcv_$type")) {
390	root	1.1	$method->($self, $attr, $type);
391			} else {
392			warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
393			}
394			}
395
396	root	1.5	sub set_result {
397	root	1.1	my ($self, $result) = @_;
398
399			$self->{result} = $result unless exists $self->{result};
400			}
401
402	root	1.5	sub eof {
403			my ($self) = @_;
404			$self->set_result;
405			}
406
407	root	1.1	=item $result = $txn->result
408
409			Waits until a result is available and then returns it.
410
411	root	1.5	This waiting is (depending on your event model) not very efficient, as it
412	root	1.1	is done outside the "mainloop".
413
414			=cut
415
416			sub result {
417			my ($self) = @_;
418
419			$Net::FCP::waitcb->() while !exists $self->{result};
420
421			return $self->{result};
422			}
423
424			sub DESTROY {
425			$Net::FCP::unregcb->($_[0]);
426			}
427
428			package Net::FCP::Txn::ClientHello;
429
430			use base Net::FCP::Txn;
431
432	root	1.2	sub rcv_node_hello {
433	root	1.1	my ($self, $attr) = @_;
434
435	root	1.5	$self->set_result ($attr);
436	root	1.1	}
437
438			package Net::FCP::Txn::ClientInfo;
439
440			use base Net::FCP::Txn;
441
442	root	1.2	sub rcv_node_info {
443	root	1.1	my ($self, $attr) = @_;
444
445	root	1.5	$self->set_result ($attr);
446	root	1.1	}
447
448			package Net::FCP::Txn::GenerateCHK;
449
450			use base Net::FCP::Txn;
451
452			sub rcv_success {
453			my ($self, $attr) = @_;
454
455	root	1.5	$self->set_result ($attr);
456	root	1.1	}
457
458			package Net::FCP::Txn::GenerateSVKPair;
459
460			use base Net::FCP::Txn;
461
462			sub rcv_success {
463			my ($self, $attr) = @_;
464
465	root	1.5	$self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
466	root	1.1	}
467
468			package Net::FCP::Txn::InvertPrivateKey;
469
470			use base Net::FCP::Txn;
471
472			sub rcv_success {
473			my ($self, $attr) = @_;
474
475	root	1.5	$self->set_result ($attr->{PublicKey});
476	root	1.1	}
477
478			package Net::FCP::Txn::GetSize;
479
480			use base Net::FCP::Txn;
481
482			sub rcv_success {
483			my ($self, $attr) = @_;
484
485	root	1.5	$self->set_result ($attr->{Length});
486			}
487
488			package Net::FCP::Txn::ClientGet;
489
490			use base Net::FCP::Txn;
491
492			sub rcv_data_found {
493			my ($self, $attr) = @_;
494
495			$self->{datalength} = hex $attr->{data_length};
496			$self->{metalength} = hex $attr->{meta_data_length};
497			}
498
499			sub eof {
500			my ($self) = @_;
501			#use PApp::Util; warn PApp::Util::dumpval $self;
502			my $data = delete $self->{data};
503			$self->set_result ([
504			(substr $data, 0, $self->{datalength}-$self->{metalength}),
505			(substr $data, $self->{datalength}-$self->{metalength}),
506			]);
507	root	1.1	}
508
509			=back
510
511			=head1 SEE ALSO
512
513			L<http://freenet.sf.net>.
514
515			=head1 BUGS
516
517			=head1 AUTHOR
518
519			Marc Lehmann <pcg@goof.com>
520			http://www.goof.com/pcg/marc/
521
522			=cut
523
524			1;
525