ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-FCP/FCP.pm
(Generate patch)

Comparing Net-FCP/FCP.pm (file contents):
Revision 1.1 by root, Sun Sep 7 22:57:40 2003 UTC vs.
Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC

… …
17of what the messages do. I am too lazy to document all this here. 17of what the messages do. I am too lazy to document all this here.
18 18
19=head1 WARNING 19=head1 WARNING
20 20
21This module is alpha. While it probably won't destroy (much :) of your 21This module is alpha. While it probably won't destroy (much :) of your
22data, it currently works only with the Event module (alkthough the event 22data, it currently falls short of what it should provide (intelligent uri
23mechanism is fully pluggable). 23following, splitfile downloads, healing...)
24
25=head2 IMPORT TAGS
26
27Nothing much can be "imported" from this module right now. There are,
28however, certain "import tags" that can be used to select the event model
29to be used.
30
31Event models are implemented as modules under the C<Net::FCP::Event::xyz>
32class, where C<xyz> is the event model to use. The default is C<Event> (or
33later C<Auto>).
34
35The import tag to use is named C<event=xyz>, e.g. C<event=Event>,
36C<event=Glib> etc.
37
38You should specify the event module to use only in the main program.
24 39
25=head2 THE Net::FCP CLASS 40=head2 THE Net::FCP CLASS
26 41
27=over 4 42=over 4
28 43
29=cut 44=cut
30 45
31package Net::FCP; 46package Net::FCP;
32 47
33use Carp; 48use Carp;
34use IO::Socket::INET;
35 49
36$VERSION = 0.01; 50$VERSION = 0.05;
37 51
38sub event_reg_cb { 52no warnings;
39 my ($obj) = @_;
40 require Event;
41 53
42 $obj->{eventdata} = Event->io ( 54our $EVENT = Net::FCP::Event::Auto::;
43 fd => $obj->{fh}, 55$EVENT = Net::FCP::Event::Event;#d#
44 poll => 'r', 56
45 cb => sub { 57sub import {
46 $obj->fh_ready; 58 shift;
59
60 for (@_) {
61 if (/^event=(\w+)$/) {
62 $EVENT = "Net::FCP::Event::$1";
47 }, 63 }
64 }
65 eval "require $EVENT";
66 die $@ if $@;
67}
68
69sub touc($) {
70 local $_ = shift;
71 1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/;
72 s/(?:^|_)(.)/\U$1/g;
73 $_;
74}
75
76sub tolc($) {
77 local $_ = shift;
78 s/(?<=[a-z])(?=[A-Z])/_/g;
79 lc $_;
80}
81
82=item $meta = Net::FCP::parse_metadata $string
83
84Parse a metadata string and return it.
85
86The metadata will be a hashref with key C<version> (containing
87the mandatory version header entries).
88
89All other headers are represented by arrayrefs (they can be repeated).
90
91Since this is confusing, here is a rather verbose example of a parsed
92manifest:
93
94 (
95 version => { revision => 1 },
96 document => [
97 {
98 "info.format" => "image/jpeg",
99 name => "background.jpg",
100 "redirect.target" => "freenet:CHK\@ZcagI,ra726bSw"
101 },
102 {
103 "info.format" => "text/html",
104 name => ".next",
105 "redirect.target" => "freenet:SSK\@ilUPAgM/TFEE/3"
106 },
107 {
108 "info.format" => "text/html",
109 "redirect.target" => "freenet:CHK\@8M8Po8ucwI,8xA"
110 }
111 ]
48 ); 112 )
49}
50 113
51sub event_unreg_cb { 114=cut
52 $_[0]{eventdata}
53 and (delete $_[0]{eventdata})->cancel;
54}
55 115
56sub event_wait_cb { 116sub parse_metadata {
57 Event::one_event(); 117 my $meta;
58}
59 118
60$regcb = \&event_reg_cb; 119 my $data = shift;
61$unregcb = \&event_unreg_cb; 120 if ($data =~ /^Version\015?\012/gc) {
62$waitcb = \&event_wait_cb; 121 my $hdr = $meta->{version} = {};
122
123 for (;;) {
124 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
125 my ($k, $v) = ($1, $2);
126 my @p = split /\./, tolc $k, 3;
127
128 $hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
129 $hdr->{$p[0]}{$p[1]} = $v if @p == 2;
130 $hdr->{$p[0]}{$p[1]}{$p[3]} = $v if @p == 3;
131 die "FATAL: 4+ dot metadata" if @p >= 4;
132 }
133
134 if ($data =~ /\GEndPart\015?\012/gc) {
135 # nop
136 } elsif ($data =~ /\GEnd\015?\012/gc) {
137 last;
138 } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
139 push @{$meta->{tolc $1}}, $hdr = {};
140 } elsif ($data =~ /\G(.*)/gcs) {
141 die "metadata format error ($1)";
142 }
143 }
144 }
145
146 #$meta->{tail} = substr $data, pos $data;
147
148 $meta;
149}
63 150
64=item $fcp = new Net::FCP [host => $host][, port => $port] 151=item $fcp = new Net::FCP [host => $host][, port => $port]
65 152
66Create a new virtual FCP connection to the given host and port (default 153Create a new virtual FCP connection to the given host and port (default
67127.0.0.1:8481). 154127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
68 155
69Connections are virtual because no persistent physical connection is 156Connections are virtual because no persistent physical connection is
70established. However, the existance of the node is checked by executing a 157established. However, the existance of the node is checked by executing a
71C<ClientHello> transaction. 158C<ClientHello> transaction.
72 159
… …
74 161
75sub new { 162sub new {
76 my $class = shift; 163 my $class = shift;
77 my $self = bless { @_ }, $class; 164 my $self = bless { @_ }, $class;
78 165
79 $self->{host} ||= "127.0.0.1"; 166 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
80 $self->{port} ||= 8481; 167 $self->{port} ||= $ENV{FREDPORT} || 8481;
81 168
82 $self->{nodehello} = $self->txn("ClientHello")->result 169 #$self->{nodehello} = $self->client_hello
83 or croak "unable to get nodehello from node\n"; 170 # or croak "unable to get nodehello from node\n";
84 171
85 $self; 172 $self;
86} 173}
87 174
175sub progress {
176 my ($self, $txn, $type, $attr) = @_;
177 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
178}
179
88=item $txn = $fcp->txn(type => attr => val,...) 180=item $txn = $fcp->txn(type => attr => val,...)
89 181
90The low-level interface to transactions. Don't use it. 182The low-level interface to transactions. Don't use it.
183
184Here are some examples of using transactions:
185
186The blocking case, no (visible) transactions involved:
187
188 my $nodehello = $fcp->client_hello;
189
190A transaction used in a blocking fashion:
191
192 my $txn = $fcp->txn_client_hello;
193 ...
194 my $nodehello = $txn->result;
195
196Or shorter:
197
198 my $nodehello = $fcp->txn_client_hello->result;
199
200Setting callbacks:
201
202 $fcp->txn_client_hello->cb(
203 sub { my $nodehello => $_[0]->result }
204 );
91 205
92=cut 206=cut
93 207
94sub txn { 208sub txn {
95 my ($self, $type, %attr) = @_; 209 my ($self, $type, %attr) = @_;
96 210
211 $type = touc $type;
212
97 my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => $type, attr => \%attr); 213 my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
98 214
99 $txn; 215 $txn;
100} 216}
101 217
102sub _txn($&) { 218sub _txn($&) {
… …
110=item $nodehello = $fcp->client_hello 226=item $nodehello = $fcp->client_hello
111 227
112Executes a ClientHello request and returns it's results. 228Executes a ClientHello request and returns it's results.
113 229
114 { 230 {
115 MaxFileSize => "5f5e100", 231 max_file_size => "5f5e100",
116 Protocol => "1.2",
117 Node => "Fred,0.6,1.46,7050" 232 node => "Fred,0.6,1.46,7050"
233 protocol => "1.2",
118 } 234 }
119 235
120=cut 236=cut
121 237
122_txn client_hello => sub { 238_txn client_hello => sub {
123 my ($self) = @_; 239 my ($self) = @_;
124 240
125 $self->txn ("ClientHello"); 241 $self->txn ("client_hello");
126}; 242};
127 243
128=item $txn = $fcp->txn_client_info 244=item $txn = $fcp->txn_client_info
129 245
130=item $nodeinfo = $fcp->client_info 246=item $nodeinfo = $fcp->client_info
131 247
132Executes a ClientInfo request and returns it's results. 248Executes a ClientInfo request and returns it's results.
133 249
134 { 250 {
135 MaxFileSize => "5f5e100",
136 DatastoreMax => "2540be400",
137 NodePort => 369,
138 JavaName => "Java HotSpot(TM) Server VM",
139 OperatingSystemVersion => "2.4.20",
140 EstimatedLoad => 52,
141 FreeMemory => "5cc0148",
142 DatastoreFree => "5ce03400",
143 NodeAddress => "1.2.3.4",
144 ActiveJobs => "1f", 251 active_jobs => "1f",
145 AllocatedMemory => "bde0000", 252 allocated_memory => "bde0000",
146 Architecture => "i386", 253 architecture => "i386",
147 RoutingTime => "a5",
148 LeastRecentTimestamp => "f41538b878",
149 AvailableThreads => 17, 254 available_threads => 17,
255 datastore_free => "5ce03400",
256 datastore_max => "2540be400",
150 DatastoreUsed => "1f72bb000", 257 datastore_used => "1f72bb000",
151 JavaVersion => "Blackdown-1.4.1-01", 258 estimated_load => 52,
259 free_memory => "5cc0148",
152 IsTransient => "false", 260 is_transient => "false",
153 OperatingSystem => "Linux", 261 java_name => "Java HotSpot(_T_M) Server VM",
154 JavaVendor => "http://www.blackdown.org/", 262 java_vendor => "http://www.blackdown.org/",
263 java_version => "Blackdown-1.4.1-01",
264 least_recent_timestamp => "f41538b878",
265 max_file_size => "5f5e100",
155 MostRecentTimestamp => "f77e2cc520" 266 most_recent_timestamp => "f77e2cc520"
267 node_address => "1.2.3.4",
268 node_port => 369,
269 operating_system => "Linux",
270 operating_system_version => "2.4.20",
271 routing_time => "a5",
156 } 272 }
157 273
158=cut 274=cut
159 275
160_txn client_info => sub { 276_txn client_info => sub {
161 my ($self) = @_; 277 my ($self) = @_;
162 278
163 $self->txn ("ClientInfo"); 279 $self->txn ("client_info");
164}; 280};
165 281
166=item $txn = $fcp->txn_generate_chk ($metadata, $data) 282=item $txn = $fcp->txn_generate_chk ($metadata, $data)
167 283
168=item $uri = $fcp->generate_chk ($metadata, $data) 284=item $uri = $fcp->generate_chk ($metadata, $data)
… …
172=cut 288=cut
173 289
174_txn generate_chk => sub { 290_txn generate_chk => sub {
175 my ($self, $metadata, $data) = @_; 291 my ($self, $metadata, $data) = @_;
176 292
177 $self->txn (GenerateCHK => data => "$data$metadata", MetaDataLength => length $metadata); 293 $self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);
178}; 294};
179 295
180=item $txn = $fcp->txn_generate_svk_pair 296=item $txn = $fcp->txn_generate_svk_pair
181 297
182=item ($public, $private) = @{ $fcp->generate_svk_pair } 298=item ($public, $private) = @{ $fcp->generate_svk_pair }
… …
191=cut 307=cut
192 308
193_txn generate_svk_pair => sub { 309_txn generate_svk_pair => sub {
194 my ($self) = @_; 310 my ($self) = @_;
195 311
196 $self->txn ("GenerateSVKPair"); 312 $self->txn ("generate_svk_pair");
197}; 313};
198 314
199=item $txn = $fcp->txn_insert_private_key ($private) 315=item $txn = $fcp->txn_insert_private_key ($private)
200 316
201=item $uri = $fcp->insert_private_key ($private) 317=item $uri = $fcp->insert_private_key ($private)
… …
211=cut 327=cut
212 328
213_txn insert_private_key => sub { 329_txn insert_private_key => sub {
214 my ($self, $privkey) = @_; 330 my ($self, $privkey) = @_;
215 331
216 $self->txn (InvertPrivateKey => Private => $privkey); 332 $self->txn (invert_private_key => private => $privkey);
217}; 333};
218 334
219=item $txn = $fcp->txn_get_size ($uri) 335=item $txn = $fcp->txn_get_size ($uri)
220 336
221=item $length = $fcp->get_size ($uri) 337=item $length = $fcp->get_size ($uri)
… …
228=cut 344=cut
229 345
230_txn get_size => sub { 346_txn get_size => sub {
231 my ($self, $uri) = @_; 347 my ($self, $uri) = @_;
232 348
233 $self->txn (GetSize => URI => $uri); 349 $self->txn (get_size => URI => $uri);
234}; 350};
235 351
352=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
353
354=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
355
356Fetches a (small, as it should fit into memory) file from
357freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
358C<undef>).
359
360Due to the overhead, a better method to download big files should be used.
361
362 my ($meta, $data) = @{
363 $fcp->client_get (
364 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
365 )
366 };
367
368=cut
369
370_txn client_get => sub {
371 my ($self, $uri, $htl, $removelocal) = @_;
372
373 $self->txn (client_get => URI => $uri, hops_to_live => ($htl || 15), remove_local_key => $removelocal ? "true" : "false");
374};
375
236=item MISSING: ClientGet, ClientPut 376=item MISSING: ClientPut
237 377
238=back 378=back
239 379
240=head2 THE Net::FCP::Txn CLASS 380=head2 THE Net::FCP::Txn CLASS
241 381
… …
252 392
253=cut 393=cut
254 394
255package Net::FCP::Txn; 395package Net::FCP::Txn;
256 396
397use Fcntl;
398use Socket;
399
257=item new arg => val,... 400=item new arg => val,...
258 401
259Creates a new C<Net::FCP::Txn> object. Not normally used. 402Creates a new C<Net::FCP::Txn> object. Not normally used.
260 403
261=cut 404=cut
262 405
263sub new { 406sub new {
264 my $class = shift; 407 my $class = shift;
265 my $self = bless { @_ }, $class; 408 my $self = bless { @_ }, $class;
266 409
410 $self->{signal} = $EVENT->new_signal;
411
412 $self->{fcp}{txn}{$self} = $self;
413
267 my $attr = ""; 414 my $attr = "";
268 my $data = delete $self->{attr}{data}; 415 my $data = delete $self->{attr}{data};
269 416
270 while (my ($k, $v) = each %{$self->{attr}}) { 417 while (my ($k, $v) = each %{$self->{attr}}) {
271 $attr .= "$k=$v\012" 418 $attr .= (Net::FCP::touc $k) . "=$v\012"
272 } 419 }
273 420
274 if (defined $data) { 421 if (defined $data) {
275 $attr .= "DataLength=" . (length $data) . "\012"; 422 $attr .= "DataLength=" . (length $data) . "\012";
276 $data = "Data\012$data"; 423 $data = "Data\012$data";
277 } else { 424 } else {
278 $data = "EndMessage\012"; 425 $data = "EndMessage\012";
279 } 426 }
280 427
281 my $fh = new IO::Socket::INET 428 socket my $fh, PF_INET, SOCK_STREAM, 0
282 PeerHost => $self->{fcp}{host}, 429 or Carp::croak "unable to create new tcp socket: $!";
283 PeerPort => $self->{fcp}{port}
284 or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
285
286 binmode $fh, ":raw"; 430 binmode $fh, ":raw";
431 fcntl $fh, F_SETFL, O_NONBLOCK;
432 connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host})
433 and !$!{EWOULDBLOCK}
434 and !$!{EINPROGRESS}
435 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
287 436
288 print 437 $self->{sbuf} =
289 $self->{type}, "\012", 438 "\x00\x00\x00\x02"
290 $attr, 439 . Net::FCP::touc $self->{type}
291 $data, "\012"; 440 . "\012$attr$data";
292
293 print $fh
294 "\x00\x00", "\x00\x02", # SESSID, PRESID
295 $self->{type}, "\012",
296 $attr,
297 $data;
298 441
299 #$fh->shutdown (1); # freenet buggy?, well, it's java... 442 #$fh->shutdown (1); # freenet buggy?, well, it's java...
300 443
301 $self->{fh} = $fh; 444 $self->{fh} = $fh;
302 445
303 $Net::FCP::regcb->($self); 446 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
304 447
305 $self; 448 $self;
306} 449}
307 450
451=item $txn = $txn->cb ($coderef)
452
453Sets a callback to be called when the request is finished. The coderef
454will be called with the txn as it's sole argument, so it has to call
455C<result> itself.
456
457Returns the txn object, useful for chaining.
458
459Example:
460
461 $fcp->txn_client_get ("freenet:CHK....")
462 ->userdata ("ehrm")
463 ->cb(sub {
464 my $data = shift->result;
465 });
466
467=cut
468
469sub cb($$) {
470 my ($self, $cb) = @_;
471 $self->{cb} = $cb;
472 $self;
473}
474
475=item $txn = $txn->userdata ([$userdata])
476
477Set user-specific data. This is useful in progress callbacks. The data can be accessed
478using C<< $txn->{userdata} >>.
479
480Returns the txn object, useful for chaining.
481
482=cut
483
484sub userdata($$) {
485 my ($self, $data) = @_;
486 $self->{userdata} = $data;
487 $self;
488}
489
308sub fh_ready { 490sub fh_ready_w {
491 my ($self) = @_;
492
493 my $len = syswrite $self->{fh}, $self->{sbuf};
494
495 if ($len > 0) {
496 substr $self->{sbuf}, 0, $len, "";
497 unless (length $self->{sbuf}) {
498 fcntl $self->{fh}, F_SETFL, 0;
499 $self->{w}->cb(sub { $self->fh_ready_r })->poll (1, 0, 1);
500 }
501 } elsif (defined $len) {
502 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
503 } else {
504 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
505 }
506}
507
508sub fh_ready_r {
309 my ($self) = @_; 509 my ($self) = @_;
310 510
311 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { 511 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
312 for (;;) { 512 for (;;) {
313 if ($self->{datalen}) { 513 if ($self->{datalen}) {
514 #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
314 if (length $self->{buf} >= $self->{datalen}) { 515 if (length $self->{buf} >= $self->{datalen}) {
315 $self->recv_data (substr $self->{buf}, 0, $self->{datalen}, ""); 516 $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
316 } else { 517 } else {
317 last; 518 last;
318 } 519 }
319 } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) { 520 } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
320 $self->{datalen} = $1; 521 $self->{datalen} = hex $1;
522 #warn "expecting new datachunk $self->{datalen}\n";#d#
321 } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) { 523 } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
322 $self->rcv ($1, {map { split /=/, $_, 2 } split /\015?\012/, $2}); 524 $self->rcv ($1, {
525 map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
526 split /\015?\012/, $2
527 });
323 } else { 528 } else {
324 last; 529 last;
325 } 530 }
326 } 531 }
327 } else { 532 } else {
328 $Net::FCP::unregcb->($self);
329 delete $self->{fh};
330 $self->eof; 533 $self->eof;
331 } 534 }
332} 535}
333 536
334sub rcv_data { 537sub rcv_data {
335 my ($self, $chunk) = @_; 538 my ($self, $chunk) = @_;
539
540 $self->{data} .= $chunk;
541
542 $self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} });
336} 543}
337 544
338sub rcv { 545sub rcv {
339 my ($self, $type, $attr) = @_; 546 my ($self, $type, $attr) = @_;
547
548 $type = Net::FCP::tolc $type;
549
340 #use PApp::Util;warn "$type => ".PApp::Util::dumpval($attr); 550 #use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
341 551
342 if (my $method = $self->can("rcv_\L$type")) { 552 if (my $method = $self->can("rcv_$type")) {
343 $method->($self, $attr, $type); 553 $method->($self, $attr, $type);
344 } else { 554 } else {
345 warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n"; 555 warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
346 $self->eof; 556 }
557}
558
559# used as a default exception thrower
560sub rcv_throw_exception {
561 my ($self, $attr, $type) = @_;
562 $self->throw (new Net::FCP::Exception $type, $attr);
563}
564
565*rcv_failed = \&Net::FCP::Txn::rcv_throw_exception;
566*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;
567
568sub throw {
569 my ($self, $exc) = @_;
570
571 $self->{exception} = $exc;
572 $self->set_result (1);
573 $self->eof; # must be last to avoid loops
574}
575
576sub set_result {
577 my ($self, $result) = @_;
578
579 unless (exists $self->{result}) {
580 $self->{result} = $result;
581 $self->{cb}->($self) if exists $self->{cb};
582 $self->{signal}->send;
347 } 583 }
348} 584}
349 585
350sub eof { 586sub eof {
351 my ($self, $result) = @_; 587 my ($self) = @_;
352 588
353 $self->{result} = $result unless exists $self->{result}; 589 delete $self->{w};
590 delete $self->{fh};
591
592 delete $self->{fcp}{txn}{$self};
593
594 $self->set_result; # just in case
595}
596
597sub progress {
598 my ($self, $type, $attr) = @_;
599 $self->{fcp}->progress ($self, $type, $attr);
354} 600}
355 601
356=item $result = $txn->result 602=item $result = $txn->result
357 603
358Waits until a result is available and then returns it. 604Waits until a result is available and then returns it.
359 605
360This waiting is (depending on your event modul) not very efficient, as it 606This waiting is (depending on your event model) not very efficient, as it
361is done outside the "mainloop". 607is done outside the "mainloop".
362 608
363=cut 609=cut
364 610
365sub result { 611sub result {
366 my ($self) = @_; 612 my ($self) = @_;
367 613
368 $Net::FCP::waitcb->() while !exists $self->{result}; 614 $self->{signal}->wait while !exists $self->{result};
615
616 die $self->{exception} if $self->{exception};
369 617
370 return $self->{result}; 618 return $self->{result};
371} 619}
372 620
373sub DESTROY {
374 $Net::FCP::unregcb->($_[0]);
375}
376
377package Net::FCP::Txn::ClientHello; 621package Net::FCP::Txn::ClientHello;
378 622
379use base Net::FCP::Txn; 623use base Net::FCP::Txn;
380 624
381sub rcv_nodehello { 625sub rcv_node_hello {
382 my ($self, $attr) = @_; 626 my ($self, $attr) = @_;
383 627
384 $self->eof ($attr); 628 $self->set_result ($attr);
385} 629}
386 630
387package Net::FCP::Txn::ClientInfo; 631package Net::FCP::Txn::ClientInfo;
388 632
389use base Net::FCP::Txn; 633use base Net::FCP::Txn;
390 634
391sub rcv_nodeinfo { 635sub rcv_node_info {
392 my ($self, $attr) = @_; 636 my ($self, $attr) = @_;
393 637
394 $self->eof ($attr); 638 $self->set_result ($attr);
395} 639}
396 640
397package Net::FCP::Txn::GenerateCHK; 641package Net::FCP::Txn::GenerateCHK;
398 642
399use base Net::FCP::Txn; 643use base Net::FCP::Txn;
400 644
401sub rcv_success { 645sub rcv_success {
402 my ($self, $attr) = @_; 646 my ($self, $attr) = @_;
403 647
404 $self->eof ($attr); 648 $self->set_result ($attr);
405} 649}
406 650
407package Net::FCP::Txn::GenerateSVKPair; 651package Net::FCP::Txn::GenerateSVKPair;
408 652
409use base Net::FCP::Txn; 653use base Net::FCP::Txn;
410 654
411sub rcv_success { 655sub rcv_success {
412 my ($self, $attr) = @_; 656 my ($self, $attr) = @_;
413 657
414 $self->eof ([$attr->{PublicKey}, $attr->{PrivateKey}]); 658 $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
415} 659}
416 660
417package Net::FCP::Txn::InvertPrivateKey; 661package Net::FCP::Txn::InvertPrivateKey;
418 662
419use base Net::FCP::Txn; 663use base Net::FCP::Txn;
420 664
421sub rcv_success { 665sub rcv_success {
422 my ($self, $attr) = @_; 666 my ($self, $attr) = @_;
423 667
424 $self->eof ($attr->{PublicKey}); 668 $self->set_result ($attr->{PublicKey});
425} 669}
426 670
427package Net::FCP::Txn::GetSize; 671package Net::FCP::Txn::GetSize;
428 672
429use base Net::FCP::Txn; 673use base Net::FCP::Txn;
430 674
431sub rcv_success { 675sub rcv_success {
432 my ($self, $attr) = @_; 676 my ($self, $attr) = @_;
433 677
434 $self->eof ($attr->{Length}); 678 $self->set_result ($attr->{Length});
679}
680
681package Net::FCP::Txn::GetPut;
682
683# base class for get and put
684
685use base Net::FCP::Txn;
686
687*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
688*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
689
690sub rcv_restarted {
691 my ($self, $attr, $type) = @_;
692
693 delete $self->{datalength};
694 delete $self->{metalength};
695 delete $self->{data};
696
697 $self->progress ($type, $attr);
698}
699
700package Net::FCP::Txn::ClientGet;
701
702use base Net::FCP::Txn::GetPut;
703
704*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;
705
706sub rcv_data_found {
707 my ($self, $attr, $type) = @_;
708
709 $self->progress ($type, $attr);
710
711 $self->{datalength} = hex $attr->{data_length};
712 $self->{metalength} = hex $attr->{metadata_length};
713}
714
715sub eof {
716 my ($self) = @_;
717
718 if ($self->{datalength} == length $self->{data}) {
719 my $data = delete $self->{data};
720 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
721
722 $self->set_result ([$meta, $data]);
723 } elsif (!exists $self->{result}) {
724 $self->throw (Net::FCP::Exception->new (short_data => {
725 reason => "unexpected eof or internal node error",
726 received => length $self->{data},
727 expected => $self->{datalength},
728 }));
729 }
730}
731
732package Net::FCP::Txn::ClientPut;
733
734use base Net::FCP::Txn::GetPut;
735
736*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
737*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
738
739sub rcv_pending {
740 my ($self, $attr, $type) = @_;
741 $self->progress ($type, $attr);
742}
743
744sub rcv_success {
745 my ($self, $attr, $type) = @_;
746 $self->set_result ($attr);
747}
748
749package Net::FCP::Exception;
750
751use overload
752 '""' => sub {
753 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";
754 };
755
756sub new {
757 my ($class, $type, $attr) = @_;
758
759 bless [Net::FCP::tolc $type, { %$attr }], $class;
435} 760}
436 761
437=back 762=back
438 763
439=head1 SEE ALSO 764=head1 SEE ALSO

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines