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

Comparing AnyEvent-FCP/FCP.pm (file contents):
Revision 1.11 by root, Fri Aug 7 01:54:00 2015 UTC vs.
Revision 1.25 by root, Wed Jun 15 09:20:42 2016 UTC

… …
61 61
62use common::sense; 62use common::sense;
63 63
64use Carp; 64use Carp;
65 65
66our $VERSION = '0.3'; 66our $VERSION = 0.5;
67 67
68use Scalar::Util (); 68use Scalar::Util ();
69 69
70use AnyEvent; 70use AnyEvent;
71use AnyEvent::Handle; 71use AnyEvent::Handle;
72use AnyEvent::Util (); 72use AnyEvent::Util ();
73
74our %TOLC; # tolc cache
73 75
74sub touc($) { 76sub touc($) {
75 local $_ = shift; 77 local $_ = shift;
76 1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime|dda)(?:_|$))/\U$1/; 78 1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime|dda)(?:_|$))/\U$1/;
77 s/(?:^|_)(.)/\U$1/g; 79 s/(?:^|_)(.)/\U$1/g;
… …
84 1 while s/([^_])(SVK|CHK|URI|FCP|DS|MIME|DDA)/$1\_$2/; 86 1 while s/([^_])(SVK|CHK|URI|FCP|DS|MIME|DDA)/$1\_$2/;
85 s/(?<=[a-z])(?=[A-Z])/_/g; 87 s/(?<=[a-z])(?=[A-Z])/_/g;
86 lc 88 lc
87} 89}
88 90
89=item $fcp = new AnyEvent::FCP [host => $host][, port => $port][, name => $name] 91=item $fcp = new AnyEvent::FCP key => value...;
90 92
91Create a new FCP connection to the given host and port (default 93Create a new FCP connection to the given host and port (default
92127.0.0.1:9481, or the environment variables C<FREDHOST> and C<FREDPORT>). 94127.0.0.1:9481, or the environment variables C<FREDHOST> and C<FREDPORT>).
93 95
94If no C<name> was specified, then AnyEvent::FCP will generate a 96If no C<name> was specified, then AnyEvent::FCP will generate a
95(hopefully) unique client name for you. 97(hopefully) unique client name for you.
96 98
99The following keys can be specified (they are all optional):
100
101=over 4
102
103=item name => $string
104
105A unique name to identify this client. If none is specified, a randomly
106generated name will be used.
107
108=item host => $hostname
109
110The hostname or IP address of the freenet node. Default is C<$ENV{FREDHOST}>
111or C<127.0.0.1>.
112
113=item port => $portnumber
114
115The port number of the FCP port. Default is C<$ENV{FREDPORT}> or C<9481>.
116
117=item timeout => $seconds
118
119The timeout, in seconds, after which a connection error is assumed when
120there is no activity. Default is C<7200>, i.e. two hours.
121
122=item keepalive => $seconds
123
124The interval, in seconds, at which keepalive messages will be
125sent. Default is C<540>, i.e. nine minutes.
126
127These keepalive messages are useful both to detect that a connection is
128no longer working and to keep any (home) routers from expiring their
129masquerading entry.
130
131=item on_eof => $callback->($fcp)
132
133Invoked when the underlying L<AnyEvent::Handle> signals EOF, currently
134regardless of whether the EOF was expected or not.
135
136=item on_error => $callback->($fcp, $message)
137
138Invoked on any (fatal) errors, such as unexpected connection close. The
139callback receives the FCP object and a textual error message.
140
141=item on_failure => $callback->($fcp, $type, $args, $backtrace, $error)
142
143Invoked when an FCP request fails that didn't have a failure callback. See
144L<FCP REQUESTS> for details.
145
146=back
147
97=cut 148=cut
98 149
99sub new { 150sub new {
100 my $class = shift; 151 my $class = shift;
152
153 my $rand = join "", map chr 0x21 + rand 94, 1..40; # ~ 262 bits entropy
154
101 my $self = bless { 155 my $self = bless {
102 host => $ENV{FREDHOST} || "127.0.0.1", 156 host => $ENV{FREDHOST} || "127.0.0.1",
103 port => $ENV{FREDPORT} || 9481, 157 port => $ENV{FREDPORT} || 9481,
104 timeout => 3600 * 2, 158 timeout => 3600 * 2,
159 keepalive => 9 * 60,
105 name => time.rand.rand.rand, # lame 160 name => time.rand.rand.rand, # lame
106 @_, 161 @_,
107 queue => [], 162 queue => [],
108 req => {}, 163 req => {},
164 prefix => "..:aefcpid:$rand:",
109 id => "a0", 165 idseq => "a0",
110 }, $class; 166 }, $class;
111 167
112 { 168 {
113 Scalar::Util::weaken (my $self = $self); 169 Scalar::Util::weaken (my $self = $self);
170
171 $self->{kw} = AE::timer $self->{keepalive}, $self->{keepalive}, sub {
172 $self->{hdl}->push_write ("\n");
173 };
174
175 our $ENDMESSAGE = qr<\012(EndMessage|Data)\012>;
176
177 # these are declared here for performance reasons
178 my ($k, $v, $type);
179 my $rdata;
180
181 my $on_read = sub {
182 my ($hdl) = @_;
183
184 # we only carve out whole messages here
185 while ($hdl->{rbuf} =~ /\012(EndMessage|Data)\012/) {
186 # remember end marker
187 $rdata = $1 eq "Data"
188 or $1 eq "EndMessage"
189 or return $self->fatal ("protocol error, expected message end, got $1\n");
190
191 my @lines = split /\012/, substr $hdl->{rbuf}, 0, $-[0];
192
193 substr $hdl->{rbuf}, 0, $+[0], ""; # remove pkg
194
195 $type = shift @lines;
196 $type = ($TOLC{$type} ||= tolc $type);
197
198 my %kv;
199
200 for (@lines) {
201 ($k, $v) = split /=/, $_, 2;
202 $k = ($TOLC{$k} ||= tolc $k);
203
204 if ($k =~ /\./) {
205 # generic, slow case
206 my @k = split /\./, $k;
207 my $ro = \\%kv;
208
209 while (@k) {
210 $k = shift @k;
211 if ($k =~ /^\d+$/) {
212 $ro = \$$ro->[$k];
213 } else {
214 $ro = \$$ro->{$k};
215 }
216 }
217
218 $$ro = $v;
219
220 next;
221 }
222
223 # special comon case, for performance only
224 $kv{$k} = $v;
225 }
226
227 if ($rdata) {
228 $_[0]->push_read (chunk => delete $kv{data_length}, sub {
229 $rdata = \$_[1];
230 $self->recv ($type, \%kv, $rdata);
231 });
232
233 last; # do not tgry to parse more messages
234 } else {
235 $self->recv ($type, \%kv);
236 }
237 }
238 };
114 239
115 $self->{hdl} = new AnyEvent::Handle 240 $self->{hdl} = new AnyEvent::Handle
116 connect => [$self->{host} => $self->{port}], 241 connect => [$self->{host} => $self->{port}],
117 timeout => $self->{timeout}, 242 timeout => $self->{timeout},
243 on_read => $on_read,
244 on_eof => sub {
245 if ($self->{on_eof}) {
246 $self->{on_eof}($self);
247 } else {
248 $self->fatal ("EOF");
249 }
250 },
118 on_error => sub { 251 on_error => sub {
119 warn "@_\n";#d# 252 $self->fatal ($_[2]);
120 exit 1;
121 }, 253 },
122 on_read => sub { $self->on_read (@_) }, 254 ;
123 on_eof => $self->{on_eof} || sub { };
124 255
125 Scalar::Util::weaken ($self->{hdl}{fcp} = $self); 256 Scalar::Util::weaken ($self->{hdl}{fcp} = $self);
126 } 257 }
127 258
128 $self->send_msg (client_hello => 259 $self->send_msg (client_hello =>
… …
131 ); 262 );
132 263
133 $self 264 $self
134} 265}
135 266
267sub fatal {
268 my ($self, $msg) = @_;
269
270 $self->{hdl}->shutdown;
271 delete $self->{kw};
272
273 if ($self->{on_error}) {
274 $self->{on_error}->($self, $msg);
275 } else {
276 die $msg;
277 }
278}
279
280sub identifier {
281 $_[0]{prefix} . ++$_[0]{idseq}
282}
283
136sub send_msg { 284sub send_msg {
137 my ($self, $type, %kv) = @_; 285 my ($self, $type, %kv) = @_;
138 286
139 my $data = delete $kv{data}; 287 my $data = delete $kv{data};
140 288
141 if (exists $kv{id_cb}) { 289 if (exists $kv{id_cb}) {
142 my $id = $kv{identifier} ||= ++$self->{id}; 290 my $id = $kv{identifier} ||= $self->identifier;
143 $self->{id}{$id} = delete $kv{id_cb}; 291 $self->{id}{$id} = delete $kv{id_cb};
144 } 292 }
145 293
146 my $msg = (touc $type) . "\012" 294 my $msg = (touc $type) . "\012"
147 . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv; 295 . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv;
… …
224 372
225 if (my $cb = $PERSISTENT_TYPE{$type}) { 373 if (my $cb = $PERSISTENT_TYPE{$type}) {
226 my $id = $kv->{identifier}; 374 my $id = $kv->{identifier};
227 my $req = $_[0]{req}{$id} ||= {}; 375 my $req = $_[0]{req}{$id} ||= {};
228 $cb->($self, $req, $kv); 376 $cb->($self, $req, $kv);
229 $self->recv (request_change => $kv, $type, @extra); 377 $self->recv (request_changed => $kv, $type, @extra);
230 } 378 }
231 379
232 my $on = $self->{on}; 380 my $on = $self->{on};
233 for (0 .. $#$on) { 381 for (0 .. $#$on) {
234 unless (my $res = $on->[$_]($self, $type, $kv, @extra)) { 382 unless (my $res = $on->[$_]($self, $type, $kv, @extra)) {
… …
243 } else { 391 } else {
244 $self->default_recv ($type, $kv, @extra); 392 $self->default_recv ($type, $kv, @extra);
245 } 393 }
246} 394}
247 395
248sub on_read {
249 my ($self) = @_;
250
251 my $type;
252 my %kv;
253 my $rdata;
254
255 my $hdr_cb; $hdr_cb = sub {
256 if ($_[1] =~ /^([^=]+)=(.*)$/) {
257 my ($k, $v) = ($1, $2);
258 my @k = split /\./, tolc $k;
259 my $ro = \\%kv;
260
261 while (@k) {
262 my $k = shift @k;
263 if ($k =~ /^\d+$/) {
264 $ro = \$$ro->[$k];
265 } else {
266 $ro = \$$ro->{$k};
267 }
268 }
269
270 $$ro = $v;
271
272 $_[0]->push_read (line => $hdr_cb);
273 } elsif ($_[1] eq "Data") {
274 $_[0]->push_read (chunk => delete $kv{data_length}, sub {
275 $rdata = \$_[1];
276 $self->recv ($type, \%kv, $rdata);
277 });
278 } elsif ($_[1] eq "EndMessage") {
279 $self->recv ($type, \%kv);
280 } else {
281 die "protocol error, expected message end, got $_[1]\n";#d#
282 }
283 };
284
285 $self->{hdl}->push_read (line => sub {
286 $type = tolc $_[1];
287 $_[0]->push_read (line => $hdr_cb);
288 });
289}
290
291sub default_recv { 396sub default_recv {
292 my ($self, $type, $kv, $rdata) = @_; 397 my ($self, $type, $kv, $rdata) = @_;
293 398
294 if ($type eq "node_hello") { 399 if ($type eq "node_hello") {
295 $self->{node_hello} = $kv; 400 $self->{node_hello} = $kv;
… …
297 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata) 402 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata)
298 and delete $self->{id}{$kv->{identifier}}; 403 and delete $self->{id}{$kv->{identifier}};
299 } 404 }
300} 405}
301 406
407=back
408
409=head2 FCP REQUESTS
410
411The following methods implement various requests. Most of them map
412directory to the FCP message of the same name. The added benefit of
413these over sending requests yourself is that they handle the necessary
414serialisation, protocol quirks, and replies.
415
416All of them exist in two versions, the variant shown in this manpage, and
417a variant with an extra C<_> at the end, and an extra C<$cb> argument. The
418version as shown is I<synchronous> - it will wait for any replies, and
419either return the reply, or croak with an error. The underscore variant
420returns immediately and invokes one or more callbacks or condvars later.
421
422For example, the call
423
424 $info = $fcp->get_plugin_info ($name, $detailed);
425
426Also comes in this underscore variant:
427
428 $fcp->get_plugin_info_ ($name, $detailed, $cb);
429
430You can think of the underscore as a kind of continuation indicator - the
431normal function waits and returns with the data, the C<_> indicates that
432you pass the continuation yourself, and the continuation will be invoked
433with the results.
434
435This callback/continuation argument (C<$cb>) can come in three forms itself:
436
437=over 4
438
439=item A code reference (or rather anything not matching some other alternative)
440
441This code reference will be invoked with the result on success. On an
442error, it will invoke the C<on_failure> callback of the FCP object, or,
443if none was defined, will die (in the event loop) with a backtrace of the
444call site.
445
446This is a popular choice, but it makes handling errors hard - make sure
447you never generate protocol errors!
448
449In the failure case, if an C<on_failure> hook exists, it will be invoked
450with the FCP object, the request type (the name of the method, an arrayref
451containing the arguments from the original request invocation, a (textual)
452backtrace as generated by C<Carp::longmess>, and the error object from the
453server, in this order, e.g.:
454
455 on_failure => sub {
456 my ($fcp, $request_type, $orig_args, $backtrace, $error_object) = @_;
457
458 warn "FCP failure ($type), $error_object->{code_description} ($error_object->{extra_description})$backtrace";
459 exit 1;
460 },
461
462=item A condvar (as returned by e.g. C<< AnyEvent->condvar >>)
463
464When a condvar is passed, it is sent (C<< $cv->send ($results) >>) the
465results when the request has finished. Should an error occur, the error
466will instead result in C<< $cv->croak ($error) >>.
467
468This is also a popular choice.
469
470=item An array with two callbacks C<[$success, $failure]>
471
472The C<$success> callback will be invoked with the results, while the
473C<$failure> callback will be invoked on any errors.
474
475The C<$failure> callback will be invoked with the error object from the
476server.
477
478=item C<undef>
479
480This is the same thing as specifying C<sub { }> as callback, i.e. on
481success, the results are ignored, while on failure, the C<on_failure> hook
482is invoked or the module dies with a backtrace.
483
484This is good for quick scripts, or when you really aren't interested in
485the results.
486
487=back
488
489=cut
490
302our $NOP_CB = sub { }; 491our $NOP_CB = sub { };
303 492
304sub _txn { 493sub _txn {
305 my ($name, $sub) = @_; 494 my ($name, $sub) = @_;
306 495
307 *{$name} = sub { 496 *{$name} = sub {
308 splice @_, 1, 0, (my $cv = AnyEvent->condvar); 497 my $cv = AE::cv;
498
499 splice @_, 1, 0, $cv, sub { $cv->croak ($_[0]{extra_description}) };
309 &$sub; 500 &$sub;
310 $cv->recv 501 $cv->recv
311 }; 502 };
312 503
313 *{"$name\_"} = sub { 504 *{"$name\_"} = sub {
505 my ($ok, $err) = pop;
506
507 if (ARRAY:: eq ref $ok) {
508 ($ok, $err) = @$ok;
509 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) {
510 $err = sub { $ok->croak ($_[0]{extra_description}) };
511 } else {
512 my $bt = Carp::longmess "AnyEvent::FCP request $name";
513 Scalar::Util::weaken (my $self = $_[0]);
514 my $args = [@_]; shift @$args;
515 $err = sub {
516 if ($self->{on_failure}) {
517 $self->{on_failure}($self, $name, $args, $bt, $_[0]);
518 } else {
519 die "$_[0]{code_description} ($_[0]{extra_description})$bt";
520 }
521 };
522 }
523
524 $ok ||= $NOP_CB;
525
314 splice @_, 1, 0, pop || $NOP_CB; 526 splice @_, 1, 0, $ok, $err;
315 &$sub; 527 &$sub;
316 }; 528 };
317} 529}
318 530
531=over 4
532
319=item $peers = $fcp->list_peers ([$with_metdata[, $with_volatile]]) 533=item $peers = $fcp->list_peers ([$with_metdata[, $with_volatile]])
320 534
321=cut 535=cut
322 536
323_txn list_peers => sub { 537_txn list_peers => sub {
324 my ($self, $cv, $with_metadata, $with_volatile) = @_; 538 my ($self, $ok, undef, $with_metadata, $with_volatile) = @_;
325 539
326 my @res; 540 my @res;
327 541
328 $self->send_msg (list_peers => 542 $self->send_msg (list_peers =>
329 with_metadata => $with_metadata ? "true" : "false", 543 with_metadata => $with_metadata ? "true" : "false",
330 with_volatile => $with_volatile ? "true" : "false", 544 with_volatile => $with_volatile ? "true" : "false",
331 id_cb => sub { 545 id_cb => sub {
332 my ($self, $type, $kv, $rdata) = @_; 546 my ($self, $type, $kv, $rdata) = @_;
333 547
334 if ($type eq "end_list_peers") { 548 if ($type eq "end_list_peers") {
335 $cv->(\@res); 549 $ok->(\@res);
336 1 550 1
337 } else { 551 } else {
338 push @res, $kv; 552 push @res, $kv;
339 0 553 0
340 } 554 }
… …
345=item $notes = $fcp->list_peer_notes ($node_identifier) 559=item $notes = $fcp->list_peer_notes ($node_identifier)
346 560
347=cut 561=cut
348 562
349_txn list_peer_notes => sub { 563_txn list_peer_notes => sub {
350 my ($self, $cv, $node_identifier) = @_; 564 my ($self, $ok, undef, $node_identifier) = @_;
351 565
352 $self->send_msg (list_peer_notes => 566 $self->send_msg (list_peer_notes =>
353 node_identifier => $node_identifier, 567 node_identifier => $node_identifier,
354 id_cb => sub { 568 id_cb => sub {
355 my ($self, $type, $kv, $rdata) = @_; 569 my ($self, $type, $kv, $rdata) = @_;
356 570
357 $cv->($kv); 571 $ok->($kv);
358 1 572 1
359 }, 573 },
360 ); 574 );
361}; 575};
362 576
363=item $fcp->watch_global ($enabled[, $verbosity_mask]) 577=item $fcp->watch_global ($enabled[, $verbosity_mask])
364 578
365=cut 579=cut
366 580
367_txn watch_global => sub { 581_txn watch_global => sub {
368 my ($self, $cv, $enabled, $verbosity_mask) = @_; 582 my ($self, $ok, $err, $enabled, $verbosity_mask) = @_;
369 583
370 $self->send_msg (watch_global => 584 $self->send_msg (watch_global =>
371 enabled => $enabled ? "true" : "false", 585 enabled => $enabled ? "true" : "false",
372 defined $verbosity_mask ? (verbosity_mask => $verbosity_mask+0) : (), 586 defined $verbosity_mask ? (verbosity_mask => $verbosity_mask+0) : (),
373 ); 587 );
374 588
375 $cv->(); 589 $ok->();
376}; 590};
377 591
378=item $reqs = $fcp->list_persistent_requests 592=item $reqs = $fcp->list_persistent_requests
379 593
380=cut 594=cut
381 595
382_txn list_persistent_requests => sub { 596_txn list_persistent_requests => sub {
383 my ($self, $cv) = @_; 597 my ($self, $ok, $err) = @_;
384 598
385 $self->serialise (list_persistent_requests => sub { 599 $self->serialise (list_persistent_requests => sub {
386 my ($self, $guard) = @_; 600 my ($self, $guard) = @_;
387 601
388 my @res; 602 my @res;
… …
393 my ($self, $type, $kv, $rdata) = @_; 607 my ($self, $type, $kv, $rdata) = @_;
394 608
395 $guard if 0; 609 $guard if 0;
396 610
397 if ($type eq "end_list_persistent_requests") { 611 if ($type eq "end_list_persistent_requests") {
398 $cv->(\@res); 612 $ok->(\@res);
399 return; 613 return;
400 } else { 614 } else {
401 my $id = $kv->{identifier}; 615 my $id = $kv->{identifier};
402 616
403 if ($type =~ /^persistent_(get|put|put_dir)$/) { 617 if ($type =~ /^persistent_(get|put|put_dir)$/) {
… …
408 1 622 1
409 }); 623 });
410 }); 624 });
411}; 625};
412 626
413=item $status = $fcp->remove_request ($global, $identifier) 627=item $sync = $fcp->modify_persistent_request ($global, $identifier[, $client_token[, $priority_class]])
414 628
415=cut 629Update either the C<client_token> or C<priority_class> of a request
630identified by C<$global> and C<$identifier>, depending on which of
631C<$client_token> and C<$priority_class> are not C<undef>.
416 632
417_txn remove_request => sub { 633=cut
418 my ($self, $cv, $global, $identifier) = @_;
419 634
635_txn modify_persistent_request => sub {
636 my ($self, $ok, $err, $global, $identifier, $client_token, $priority_class) = @_;
637
638 $self->serialise ($identifier => sub {
639 my ($self, $guard) = @_;
640
420 $self->send_msg (remove_request => 641 $self->send_msg (modify_persistent_request =>
421 global => $global ? "true" : "false", 642 global => $global ? "true" : "false",
422 identifier => $identifier, 643 identifier => $identifier,
423 id_cb => sub { 644 defined $client_token ? (client_token => $client_token ) : (),
645 defined $priority_class ? (priority_class => $priority_class) : (),
646 );
647
648 $self->on (sub {
424 my ($self, $type, $kv, $rdata) = @_; 649 my ($self, $type, $kv, @extra) = @_;
425 650
651 $guard if 0;
652
653 if ($kv->{identifier} eq $identifier) {
654 if ($type eq "persistent_request_modified") {
426 $cv->($kv); 655 $ok->($kv);
656 return;
657 } elsif ($type eq "protocol_error") {
658 $err->($kv);
659 return;
660 }
661 }
662
427 1 663 1
428 }, 664 });
429 ); 665 });
430}; 666};
431 667
432=item $sync = $fcp->modify_persistent_request ($global, $identifier[, $client_token[, $priority_class]])
433
434=cut
435
436_txn modify_persistent_request => sub {
437 my ($self, $cv, $global, $identifier, $client_token, $priority_class) = @_;
438
439 $self->send_msg (modify_persistent_request =>
440 global => $global ? "true" : "false",
441 defined $client_token ? (client_token => $client_token ) : (),
442 defined $priority_class ? (priority_class => $priority_class) : (),
443 identifier => $identifier,
444 id_cb => sub {
445 my ($self, $type, $kv, $rdata) = @_;
446
447 $cv->($kv);
448 1
449 },
450 );
451};
452
453=item $info = $fcp->get_plugin_info ($name, $detailed) 668=item $info = $fcp->get_plugin_info ($name, $detailed)
454 669
455=cut 670=cut
456 671
457_txn get_plugin_info => sub { 672_txn get_plugin_info => sub {
458 my ($self, $cv, $name, $detailed) = @_; 673 my ($self, $ok, $err, $name, $detailed) = @_;
674
675 my $id = $self->identifier;
459 676
460 $self->send_msg (get_plugin_info => 677 $self->send_msg (get_plugin_info =>
678 identifier => $id,
461 plugin_name => $name, 679 plugin_name => $name,
462 detailed => $detailed ? "true" : "false", 680 detailed => $detailed ? "true" : "false",
463 id_cb => sub {
464 my ($self, $type, $kv, $rdata) = @_;
465
466 $cv->($kv);
467 1
468 },
469 ); 681 );
682 $self->on (sub {
683 my ($self, $type, $kv) = @_;
684
685 if ($kv->{identifier} eq $id) {
686 if ($type eq "get_plugin_info") {
687 $ok->($kv);
688 } else {
689 $err->($kv, $type);
690 }
691 return;
692 }
693
694 1
695 });
470}; 696};
471 697
472=item $status = $fcp->client_get ($uri, $identifier, %kv) 698=item $status = $fcp->client_get ($uri, $identifier, %kv)
473 699
474%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>). 700%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>).
… …
478binary_blob, allowed_mime_types, filename, temp_filename 704binary_blob, allowed_mime_types, filename, temp_filename
479 705
480=cut 706=cut
481 707
482_txn client_get => sub { 708_txn client_get => sub {
483 my ($self, $cv, $uri, $identifier, %kv) = @_; 709 my ($self, $ok, $err, $uri, $identifier, %kv) = @_;
484 710
711 $self->serialise ($identifier => sub {
712 my ($self, $guard) = @_;
713
485 $self->send_msg (client_get => 714 $self->send_msg (client_get =>
486 %kv, 715 %kv,
487 uri => $uri, 716 uri => $uri,
488 identifier => $identifier, 717 identifier => $identifier,
718 );
719
720 $self->on (sub {
721 my ($self, $type, $kv, @extra) = @_;
722
723 $guard if 0;
724
725 if ($kv->{identifier} eq $identifier) {
726 if ($type eq "persistent_get") {
727 $ok->($kv);
728 return;
729 } elsif ($type eq "protocol_error") {
730 $err->($kv);
731 return;
732 }
733 }
734
735 1
736 });
489 ); 737 });
490}; 738};
491 739
492=item $status = $fcp->remove_request ($identifier[, $global]) 740=item $status = $fcp->remove_request ($identifier[, $global])
493 741
494Remove the request with the given isdentifier. Returns true if successful, 742Remove the request with the given identifier. Returns true if successful,
495false on error. 743false on error.
496 744
497=cut 745=cut
498 746
499_txn remove_request => sub { 747_txn remove_request => sub {
500 my ($self, $cv, $identifier, $global) = @_; 748 my ($self, $ok, $err, $identifier, $global) = @_;
501 749
502 $self->serialise ($identifier => sub { 750 $self->serialise ($identifier => sub {
503 my ($self, $guard) = @_; 751 my ($self, $guard) = @_;
504 752
505 $self->send_msg (remove_request => 753 $self->send_msg (remove_request =>
… …
507 global => $global ? "true" : "false", 755 global => $global ? "true" : "false",
508 ); 756 );
509 $self->on (sub { 757 $self->on (sub {
510 my ($self, $type, $kv, @extra) = @_; 758 my ($self, $type, $kv, @extra) = @_;
511 759
760 $guard if 0;
761
512 if ($kv->{identifier} eq $identifier) { 762 if ($kv->{identifier} eq $identifier) {
513 if ($type eq "persistent_request_removed") { 763 if ($type eq "persistent_request_removed") {
514 $cv->(1); 764 $ok->(1);
515 return; 765 return;
516 } elsif ($type eq "protocol_error") { 766 } elsif ($type eq "protocol_error") {
517 $cv->(undef); 767 $err->($kv);
518 return; 768 return;
519 } 769 }
520 } 770 }
521 771
522 1 772 1
… …
542 792
543C<$want_read> and C<$want_write> should be set to a true value when you 793C<$want_read> and C<$want_write> should be set to a true value when you
544want to read (get) files or write (put) files, respectively. 794want to read (get) files or write (put) files, respectively.
545 795
546On error, an exception is thrown. Otherwise, C<$can_read> and 796On error, an exception is thrown. Otherwise, C<$can_read> and
547C<$can_write> indicate whether you can reaqd or write to freenet via the 797C<$can_write> indicate whether you can read or write to freenet via the
548directory. 798directory.
549 799
550=cut 800=cut
551 801
552_txn test_dda => sub { 802_txn test_dda => sub {
553 my ($self, $cv, $local, $remote, $want_read, $want_write) = @_; 803 my ($self, $ok, $err, $local, $remote, $want_read, $want_write) = @_;
554 804
555 $self->serialise (test_dda => sub { 805 $self->serialise (test_dda => sub {
556 my ($self, $guard) = @_; 806 my ($self, $guard) = @_;
557 807
558 $self->send_msg (test_dda_request => 808 $self->send_msg (test_dda_request =>
… …
599 my ($self, $type, $kv) = @_; 849 my ($self, $type, $kv) = @_;
600 850
601 $guard if 0; # reference 851 $guard if 0; # reference
602 852
603 if ($type eq "test_dda_complete") { 853 if ($type eq "test_dda_complete") {
604 $cv->( 854 $ok->(
605 $kv->{read_directory_allowed} eq "true", 855 $kv->{read_directory_allowed} eq "true",
606 $kv->{write_directory_allowed} eq "true", 856 $kv->{write_directory_allowed} eq "true",
607 ); 857 );
608 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) { 858 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) {
609 $cv->croak ($kv->{extra_description}); 859 $err->($kv->{extra_description});
610 return; 860 return;
611 } 861 }
612 862
613 1 863 1
614 }); 864 });
615 865
616 return; 866 return;
617 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) { 867 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) {
618 $cv->croak ($kv->{extra_description}); 868 $err->($kv);
619 return; 869 return;
620 } 870 }
621 871
622 1 872 1
623 }); 873 });
… …
673on every change, which will be called as C<< $cb->($fcp, $kv, $type) >>, where C<$type> 923on every change, which will be called as C<< $cb->($fcp, $kv, $type) >>, where C<$type>
674is the type of the original message triggering the change, 924is the type of the original message triggering the change,
675 925
676To fill this cache with the global queue and keep it updated, 926To fill this cache with the global queue and keep it updated,
677call C<watch_global> to subscribe to updates, followed by 927call C<watch_global> to subscribe to updates, followed by
678C<list_persistent_requests_sync>. 928C<list_persistent_requests>.
679 929
680 $fcp->watch_global_sync_; # do not wait 930 $fcp->watch_global_; # do not wait
681 $fcp->list_persistent_requests; # wait 931 $fcp->list_persistent_requests; # wait
682 932
683To get a better idea of what is stored in the cache, here is an example of 933To get a better idea of what is stored in the cache, here is an example of
684what might be stored in C<< $fcp->{req}{"Frost-gpl.txt"} >>: 934what might be stored in C<< $fcp->{req}{"Frost-gpl.txt"} >>:
685 935
… …
794 if 0.1 > rand; 1044 if 0.1 > rand;
795 } 1045 }
796 } 1046 }
797 1047
798 # see if the dummy plugin is loaded, to ensure all previous requests have finished. 1048 # see if the dummy plugin is loaded, to ensure all previous requests have finished.
799 $fcp->get_plugin_info_sync ("dummy"); 1049 $fcp->get_plugin_info ("dummy");
800 1050
801=head1 SEE ALSO 1051=head1 SEE ALSO
802 1052
803L<http://wiki.freenetproject.org/FreenetFCPSpec2Point0>, L<Net::FCP>. 1053L<http://wiki.freenetproject.org/FreenetFCPSpec2Point0>, L<Net::FCP>.
804 1054

Diff Legend

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