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.15 by root, Fri Aug 14 03:33:13 2015 UTC

… …
96 96
97=cut 97=cut
98 98
99sub new { 99sub new {
100 my $class = shift; 100 my $class = shift;
101
102 my $rand = join "", map chr 0x21 + rand 94, 1..40; # ~ 262 bits entropy
103
101 my $self = bless { 104 my $self = bless {
102 host => $ENV{FREDHOST} || "127.0.0.1", 105 host => $ENV{FREDHOST} || "127.0.0.1",
103 port => $ENV{FREDPORT} || 9481, 106 port => $ENV{FREDPORT} || 9481,
104 timeout => 3600 * 2, 107 timeout => 3600 * 2,
105 name => time.rand.rand.rand, # lame 108 name => time.rand.rand.rand, # lame
106 @_, 109 @_,
107 queue => [], 110 queue => [],
108 req => {}, 111 req => {},
112 prefix => "..:aefcpid:$rand:",
109 id => "a0", 113 idseq => "a0",
110 }, $class; 114 }, $class;
111 115
112 { 116 {
113 Scalar::Util::weaken (my $self = $self); 117 Scalar::Util::weaken (my $self = $self);
114 118
… …
131 ); 135 );
132 136
133 $self 137 $self
134} 138}
135 139
140sub identifier {
141 $_[0]{prefix} . ++$_[0]{idseq}
142}
143
136sub send_msg { 144sub send_msg {
137 my ($self, $type, %kv) = @_; 145 my ($self, $type, %kv) = @_;
138 146
139 my $data = delete $kv{data}; 147 my $data = delete $kv{data};
140 148
141 if (exists $kv{id_cb}) { 149 if (exists $kv{id_cb}) {
142 my $id = $kv{identifier} ||= ++$self->{id}; 150 my $id = $kv{identifier} ||= $self->identifier;
143 $self->{id}{$id} = delete $kv{id_cb}; 151 $self->{id}{$id} = delete $kv{id_cb};
144 } 152 }
145 153
146 my $msg = (touc $type) . "\012" 154 my $msg = (touc $type) . "\012"
147 . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv; 155 . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv;
… …
297 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata) 305 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata)
298 and delete $self->{id}{$kv->{identifier}}; 306 and delete $self->{id}{$kv->{identifier}};
299 } 307 }
300} 308}
301 309
310=back
311
312=head2 FCP REQUESTS
313
314The following methods implement various requests. Most of them map
315directory to the FCP message of the same name. The added benefit of
316these over sending requests yourself is that they handle the necessary
317serialisation, protocol quirks, and replies.
318
319All of them exist in two versions, the variant shown in this manpage, and
320a variant with an extra C<_> at the end, and an extra C<$cb> argument. The
321version as shown is I<synchronous> - it will wait for any replies, and
322either return the reply, or croak with an error. The underscore variant
323returns immediately and invokes one or more callbacks or condvars later.
324
325For example, the call
326
327 $info = $fcp->get_plugin_info ($name, $detailed);
328
329Also comes in this underscore variant:
330
331 $fcp->get_plugin_info_ ($name, $detailed, $cb);
332
333You can thinbk of the underscore as a kind of continuation indicator - the
334normal function waits and returns with the data, the C<_> indicates that
335you pass the continuation yourself, and the continuation will be invoked
336with the results.
337
338This callback/continuation argument (C<$cb>) can come in three forms itself:
339
340=over 4
341
342=item A code reference (or rather anything not matching some other alternative)
343
344This code reference will be invoked with the result on success. On an
345error, it will die (in the event loop) with a backtrace of the call site.
346
347This is a popular choice, but it makes handling errors hard - make sure
348you never generate protocol errors!
349
350=item A condvar (as returned by e.g. C<< AnyEvent->condvar >>)
351
352When a condvar is passed, it is sent (C<< $cv->send ($results) >>) the
353results when the request has finished. Should an error occur, the error
354will instead result in C<< $cv->croak ($error) >>.
355
356This is also a popular choice.
357
358=item An array with two callbacks C<[$success, $failure]>
359
360The C<$success> callback will be invoked with the results, while the
361C<$failure> callback will be invoked on any errors.
362
363=item C<undef>
364
365This is the same thing as specifying C<sub { }> as callback, i.e. on
366success, the results are ignored, while on failure, you the module dies
367with a backtrace.
368
369This is good for quick scripts, or when you really aren't interested in
370the results.
371
372=back
373
374=cut
375
302our $NOP_CB = sub { }; 376our $NOP_CB = sub { };
303 377
304sub _txn { 378sub _txn {
305 my ($name, $sub) = @_; 379 my ($name, $sub) = @_;
306 380
307 *{$name} = sub { 381 *{$name} = sub {
308 splice @_, 1, 0, (my $cv = AnyEvent->condvar); 382 my $cv = AE::cv;
383
384 splice @_, 1, 0, $cv, sub { $cv->croak ($_[0]{extra_description}) };
309 &$sub; 385 &$sub;
310 $cv->recv 386 $cv->recv
311 }; 387 };
312 388
313 *{"$name\_"} = sub { 389 *{"$name\_"} = sub {
390 my ($ok, $err) = pop;
391
392 if (ARRAY:: eq ref $ok) {
393 ($ok, $err) = @$ok;
394 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) {
395 $err = sub { $ok->croak ($_[0]{extra_description}) };
396 } else {
397 my $bt = Carp::longmess "";
398 $err = sub {
399 die "$_[0]{code_description} ($_[0]{extra_description})$bt";
400 };
401 }
402
403 $ok ||= $NOP_CB;
404
314 splice @_, 1, 0, pop || $NOP_CB; 405 splice @_, 1, 0, $ok, $err;
315 &$sub; 406 &$sub;
316 }; 407 };
317} 408}
318 409
410=over 4
411
319=item $peers = $fcp->list_peers ([$with_metdata[, $with_volatile]]) 412=item $peers = $fcp->list_peers ([$with_metdata[, $with_volatile]])
320 413
321=cut 414=cut
322 415
323_txn list_peers => sub { 416_txn list_peers => sub {
324 my ($self, $cv, $with_metadata, $with_volatile) = @_; 417 my ($self, $ok, undef, $with_metadata, $with_volatile) = @_;
325 418
326 my @res; 419 my @res;
327 420
328 $self->send_msg (list_peers => 421 $self->send_msg (list_peers =>
329 with_metadata => $with_metadata ? "true" : "false", 422 with_metadata => $with_metadata ? "true" : "false",
330 with_volatile => $with_volatile ? "true" : "false", 423 with_volatile => $with_volatile ? "true" : "false",
331 id_cb => sub { 424 id_cb => sub {
332 my ($self, $type, $kv, $rdata) = @_; 425 my ($self, $type, $kv, $rdata) = @_;
333 426
334 if ($type eq "end_list_peers") { 427 if ($type eq "end_list_peers") {
335 $cv->(\@res); 428 $ok->(\@res);
336 1 429 1
337 } else { 430 } else {
338 push @res, $kv; 431 push @res, $kv;
339 0 432 0
340 } 433 }
… …
345=item $notes = $fcp->list_peer_notes ($node_identifier) 438=item $notes = $fcp->list_peer_notes ($node_identifier)
346 439
347=cut 440=cut
348 441
349_txn list_peer_notes => sub { 442_txn list_peer_notes => sub {
350 my ($self, $cv, $node_identifier) = @_; 443 my ($self, $ok, undef, $node_identifier) = @_;
351 444
352 $self->send_msg (list_peer_notes => 445 $self->send_msg (list_peer_notes =>
353 node_identifier => $node_identifier, 446 node_identifier => $node_identifier,
354 id_cb => sub { 447 id_cb => sub {
355 my ($self, $type, $kv, $rdata) = @_; 448 my ($self, $type, $kv, $rdata) = @_;
356 449
357 $cv->($kv); 450 $ok->($kv);
358 1 451 1
359 }, 452 },
360 ); 453 );
361}; 454};
362 455
363=item $fcp->watch_global ($enabled[, $verbosity_mask]) 456=item $fcp->watch_global ($enabled[, $verbosity_mask])
364 457
365=cut 458=cut
366 459
367_txn watch_global => sub { 460_txn watch_global => sub {
368 my ($self, $cv, $enabled, $verbosity_mask) = @_; 461 my ($self, $ok, $err, $enabled, $verbosity_mask) = @_;
369 462
370 $self->send_msg (watch_global => 463 $self->send_msg (watch_global =>
371 enabled => $enabled ? "true" : "false", 464 enabled => $enabled ? "true" : "false",
372 defined $verbosity_mask ? (verbosity_mask => $verbosity_mask+0) : (), 465 defined $verbosity_mask ? (verbosity_mask => $verbosity_mask+0) : (),
373 ); 466 );
374 467
375 $cv->(); 468 $ok->();
376}; 469};
377 470
378=item $reqs = $fcp->list_persistent_requests 471=item $reqs = $fcp->list_persistent_requests
379 472
380=cut 473=cut
381 474
382_txn list_persistent_requests => sub { 475_txn list_persistent_requests => sub {
383 my ($self, $cv) = @_; 476 my ($self, $ok, $err) = @_;
384 477
385 $self->serialise (list_persistent_requests => sub { 478 $self->serialise (list_persistent_requests => sub {
386 my ($self, $guard) = @_; 479 my ($self, $guard) = @_;
387 480
388 my @res; 481 my @res;
… …
393 my ($self, $type, $kv, $rdata) = @_; 486 my ($self, $type, $kv, $rdata) = @_;
394 487
395 $guard if 0; 488 $guard if 0;
396 489
397 if ($type eq "end_list_persistent_requests") { 490 if ($type eq "end_list_persistent_requests") {
398 $cv->(\@res); 491 $ok->(\@res);
399 return; 492 return;
400 } else { 493 } else {
401 my $id = $kv->{identifier}; 494 my $id = $kv->{identifier};
402 495
403 if ($type =~ /^persistent_(get|put|put_dir)$/) { 496 if ($type =~ /^persistent_(get|put|put_dir)$/) {
… …
408 1 501 1
409 }); 502 });
410 }); 503 });
411}; 504};
412 505
413=item $status = $fcp->remove_request ($global, $identifier) 506=item $sync = $fcp->modify_persistent_request ($global, $identifier[, $client_token[, $priority_class]])
414 507
415=cut 508Update either the C<client_token> or C<priority_class> of a request
509identified by C<$global> and C<$identifier>, depending on which of
510C<$client_token> and C<$priority_class> are not C<undef>.
416 511
417_txn remove_request => sub { 512=cut
418 my ($self, $cv, $global, $identifier) = @_;
419 513
514_txn modify_persistent_request => sub {
515 my ($self, $ok, $err, $global, $identifier, $client_token, $priority_class) = @_;
516
517 $self->serialise ($identifier => sub {
518 my ($self, $guard) = @_;
519
420 $self->send_msg (remove_request => 520 $self->send_msg (modify_persistent_request =>
421 global => $global ? "true" : "false", 521 global => $global ? "true" : "false",
422 identifier => $identifier, 522 identifier => $identifier,
423 id_cb => sub { 523 defined $client_token ? (client_token => $client_token ) : (),
524 defined $priority_class ? (priority_class => $priority_class) : (),
525 );
526
527 $self->on (sub {
424 my ($self, $type, $kv, $rdata) = @_; 528 my ($self, $type, $kv, @extra) = @_;
425 529
530 $guard if 0;
531
532 if ($kv->{identifier} eq $identifier) {
533 if ($type eq "persistent_request_modified") {
426 $cv->($kv); 534 $ok->($kv);
535 return;
536 } elsif ($type eq "protocol_error") {
537 $err->($kv);
538 return;
539 }
540 }
541
427 1 542 1
428 }, 543 });
429 ); 544 });
430}; 545};
431 546
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) 547=item $info = $fcp->get_plugin_info ($name, $detailed)
454 548
455=cut 549=cut
456 550
457_txn get_plugin_info => sub { 551_txn get_plugin_info => sub {
458 my ($self, $cv, $name, $detailed) = @_; 552 my ($self, $ok, $err, $name, $detailed) = @_;
553
554 my $id = $self->identifier;
459 555
460 $self->send_msg (get_plugin_info => 556 $self->send_msg (get_plugin_info =>
557 identifier => $id,
461 plugin_name => $name, 558 plugin_name => $name,
462 detailed => $detailed ? "true" : "false", 559 detailed => $detailed ? "true" : "false",
463 id_cb => sub {
464 my ($self, $type, $kv, $rdata) = @_;
465
466 $cv->($kv);
467 1
468 },
469 ); 560 );
561 $self->on (sub {
562 my ($self, $type, $kv) = @_;
563
564 if ($kv->{identifier} eq $id) {
565 if ($type eq "get_plugin_info") {
566 $ok->($kv);
567 } else {
568 $err->($kv, $type);
569 }
570 return;
571 }
572
573 1
574 });
470}; 575};
471 576
472=item $status = $fcp->client_get ($uri, $identifier, %kv) 577=item $status = $fcp->client_get ($uri, $identifier, %kv)
473 578
474%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>). 579%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>).
… …
478binary_blob, allowed_mime_types, filename, temp_filename 583binary_blob, allowed_mime_types, filename, temp_filename
479 584
480=cut 585=cut
481 586
482_txn client_get => sub { 587_txn client_get => sub {
483 my ($self, $cv, $uri, $identifier, %kv) = @_; 588 my ($self, $ok, $err, $uri, $identifier, %kv) = @_;
484 589
590 $self->serialise ($identifier => sub {
591 my ($self, $guard) = @_;
592
485 $self->send_msg (client_get => 593 $self->send_msg (client_get =>
486 %kv, 594 %kv,
487 uri => $uri, 595 uri => $uri,
488 identifier => $identifier, 596 identifier => $identifier,
597 );
598
599 $self->on (sub {
600 my ($self, $type, $kv, @extra) = @_;
601
602 $guard if 0;
603
604 if ($kv->{identifier} eq $identifier) {
605 if ($type eq "persistent_get") {
606 $ok->($kv);
607 return;
608 } elsif ($type eq "protocol_error") {
609 $err->($kv);
610 return;
611 }
612 }
613
614 1
615 });
489 ); 616 });
490}; 617};
491 618
492=item $status = $fcp->remove_request ($identifier[, $global]) 619=item $status = $fcp->remove_request ($identifier[, $global])
493 620
494Remove the request with the given isdentifier. Returns true if successful, 621Remove the request with the given isdentifier. Returns true if successful,
495false on error. 622false on error.
496 623
497=cut 624=cut
498 625
499_txn remove_request => sub { 626_txn remove_request => sub {
500 my ($self, $cv, $identifier, $global) = @_; 627 my ($self, $ok, $err, $identifier, $global) = @_;
501 628
502 $self->serialise ($identifier => sub { 629 $self->serialise ($identifier => sub {
503 my ($self, $guard) = @_; 630 my ($self, $guard) = @_;
504 631
505 $self->send_msg (remove_request => 632 $self->send_msg (remove_request =>
… …
507 global => $global ? "true" : "false", 634 global => $global ? "true" : "false",
508 ); 635 );
509 $self->on (sub { 636 $self->on (sub {
510 my ($self, $type, $kv, @extra) = @_; 637 my ($self, $type, $kv, @extra) = @_;
511 638
639 $guard if 0;
640
512 if ($kv->{identifier} eq $identifier) { 641 if ($kv->{identifier} eq $identifier) {
513 if ($type eq "persistent_request_removed") { 642 if ($type eq "persistent_request_removed") {
514 $cv->(1); 643 $ok->(1);
515 return; 644 return;
516 } elsif ($type eq "protocol_error") { 645 } elsif ($type eq "protocol_error") {
517 $cv->(undef); 646 $err->($kv);
518 return; 647 return;
519 } 648 }
520 } 649 }
521 650
522 1 651 1
… …
548directory. 677directory.
549 678
550=cut 679=cut
551 680
552_txn test_dda => sub { 681_txn test_dda => sub {
553 my ($self, $cv, $local, $remote, $want_read, $want_write) = @_; 682 my ($self, $ok, $err, $local, $remote, $want_read, $want_write) = @_;
554 683
555 $self->serialise (test_dda => sub { 684 $self->serialise (test_dda => sub {
556 my ($self, $guard) = @_; 685 my ($self, $guard) = @_;
557 686
558 $self->send_msg (test_dda_request => 687 $self->send_msg (test_dda_request =>
… …
599 my ($self, $type, $kv) = @_; 728 my ($self, $type, $kv) = @_;
600 729
601 $guard if 0; # reference 730 $guard if 0; # reference
602 731
603 if ($type eq "test_dda_complete") { 732 if ($type eq "test_dda_complete") {
604 $cv->( 733 $ok->(
605 $kv->{read_directory_allowed} eq "true", 734 $kv->{read_directory_allowed} eq "true",
606 $kv->{write_directory_allowed} eq "true", 735 $kv->{write_directory_allowed} eq "true",
607 ); 736 );
608 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) { 737 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) {
609 $cv->croak ($kv->{extra_description}); 738 $err->($kv->{extra_description});
610 return; 739 return;
611 } 740 }
612 741
613 1 742 1
614 }); 743 });
615 744
616 return; 745 return;
617 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) { 746 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) {
618 $cv->croak ($kv->{extra_description}); 747 $err->($kv);
619 return; 748 return;
620 } 749 }
621 750
622 1 751 1
623 }); 752 });

Diff Legend

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