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.19 by root, Tue Jun 7 18:53:23 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.4;
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;
… …
96 98
97=cut 99=cut
98 100
99sub new { 101sub new {
100 my $class = shift; 102 my $class = shift;
103
104 my $rand = join "", map chr 0x21 + rand 94, 1..40; # ~ 262 bits entropy
105
101 my $self = bless { 106 my $self = bless {
102 host => $ENV{FREDHOST} || "127.0.0.1", 107 host => $ENV{FREDHOST} || "127.0.0.1",
103 port => $ENV{FREDPORT} || 9481, 108 port => $ENV{FREDPORT} || 9481,
104 timeout => 3600 * 2, 109 timeout => 3600 * 2,
110 keepalive => 9 * 60,
105 name => time.rand.rand.rand, # lame 111 name => time.rand.rand.rand, # lame
106 @_, 112 @_,
107 queue => [], 113 queue => [],
108 req => {}, 114 req => {},
115 prefix => "..:aefcpid:$rand:",
109 id => "a0", 116 idseq => "a0",
110 }, $class; 117 }, $class;
111 118
112 { 119 {
113 Scalar::Util::weaken (my $self = $self); 120 Scalar::Util::weaken (my $self = $self);
121
122 $self->{kw} = AE::timer $self->{keepalive}, $self->{keepalive}, sub {
123 $self->{hdl}->push_write ("\n");
124 };
125
126 our $ENDMESSAGE = qr<\012(EndMessage|Data)\012>;
127
128 # these are declared here for performance reasons
129 my ($k, $v, $type);
130 my $rdata;
131
132 my $on_read = sub {
133 my ($hdl) = @_;
134
135 # we only carve out whole messages here
136 while ($hdl->{rbuf} =~ /\012(EndMessage|Data)\012/) {
137 # remember end marker
138 $rdata = $1 eq "Data"
139 or $1 eq "EndMessage"
140 or return $self->fatal ("protocol error, expected message end, got $1\n");
141
142 my @lines = split /\012/, substr $hdl->{rbuf}, 0, $-[0];
143
144 substr $hdl->{rbuf}, 0, $+[0], ""; # remove pkg
145
146 $type = shift @lines;
147 $type = ($TOLC{$type} ||= tolc $type);
148
149 my %kv;
150
151 for (@lines) {
152 ($k, $v) = split /=/, $_, 2;
153 $k = ($TOLC{$k} ||= tolc $k);
154
155 if ($k =~ /\./) {
156 # generic, slow case
157 my @k = split /\./, $k;
158 my $ro = \\%kv;
159
160 while (@k) {
161 $k = shift @k;
162 if ($k =~ /^\d+$/) {
163 $ro = \$$ro->[$k];
164 } else {
165 $ro = \$$ro->{$k};
166 }
167 }
168
169 $$ro = $v;
170
171 next;
172 }
173
174 # special comon case, for performance only
175 $kv{$k} = $v;
176 }
177
178 if ($rdata) {
179 $_[0]->push_read (chunk => delete $kv{data_length}, sub {
180 $rdata = \$_[1];
181 $self->recv ($type, \%kv, $rdata);
182 });
183
184 last; # do not tgry to parse more messages
185 } else {
186 $self->recv ($type, \%kv);
187 }
188 }
189 };
114 190
115 $self->{hdl} = new AnyEvent::Handle 191 $self->{hdl} = new AnyEvent::Handle
116 connect => [$self->{host} => $self->{port}], 192 connect => [$self->{host} => $self->{port}],
117 timeout => $self->{timeout}, 193 timeout => $self->{timeout},
194 on_read => $on_read,
195 on_eof => $self->{on_eof},
118 on_error => sub { 196 on_error => sub {
119 warn "@_\n";#d# 197 $self->fatal ($_[2]);
120 exit 1;
121 }, 198 },
122 on_read => sub { $self->on_read (@_) }, 199 ;
123 on_eof => $self->{on_eof} || sub { };
124 200
125 Scalar::Util::weaken ($self->{hdl}{fcp} = $self); 201 Scalar::Util::weaken ($self->{hdl}{fcp} = $self);
126 } 202 }
127 203
128 $self->send_msg (client_hello => 204 $self->send_msg (client_hello =>
… …
131 ); 207 );
132 208
133 $self 209 $self
134} 210}
135 211
212sub fatal {
213 my ($self, $msg) = @_;
214
215 $self->{hdl}->shutdown;
216 delete $self->{kw};
217
218 if ($self->{on_error}) {
219 $self->{on_error}->($msg);
220 } else {
221 die $msg;
222 }
223}
224
225sub identifier {
226 $_[0]{prefix} . ++$_[0]{idseq}
227}
228
136sub send_msg { 229sub send_msg {
137 my ($self, $type, %kv) = @_; 230 my ($self, $type, %kv) = @_;
138 231
139 my $data = delete $kv{data}; 232 my $data = delete $kv{data};
140 233
141 if (exists $kv{id_cb}) { 234 if (exists $kv{id_cb}) {
142 my $id = $kv{identifier} ||= ++$self->{id}; 235 my $id = $kv{identifier} ||= $self->identifier;
143 $self->{id}{$id} = delete $kv{id_cb}; 236 $self->{id}{$id} = delete $kv{id_cb};
144 } 237 }
145 238
146 my $msg = (touc $type) . "\012" 239 my $msg = (touc $type) . "\012"
147 . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv; 240 . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv;
… …
224 317
225 if (my $cb = $PERSISTENT_TYPE{$type}) { 318 if (my $cb = $PERSISTENT_TYPE{$type}) {
226 my $id = $kv->{identifier}; 319 my $id = $kv->{identifier};
227 my $req = $_[0]{req}{$id} ||= {}; 320 my $req = $_[0]{req}{$id} ||= {};
228 $cb->($self, $req, $kv); 321 $cb->($self, $req, $kv);
229 $self->recv (request_change => $kv, $type, @extra); 322 $self->recv (request_changed => $kv, $type, @extra);
230 } 323 }
231 324
232 my $on = $self->{on}; 325 my $on = $self->{on};
233 for (0 .. $#$on) { 326 for (0 .. $#$on) {
234 unless (my $res = $on->[$_]($self, $type, $kv, @extra)) { 327 unless (my $res = $on->[$_]($self, $type, $kv, @extra)) {
… …
243 } else { 336 } else {
244 $self->default_recv ($type, $kv, @extra); 337 $self->default_recv ($type, $kv, @extra);
245 } 338 }
246} 339}
247 340
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 { 341sub default_recv {
292 my ($self, $type, $kv, $rdata) = @_; 342 my ($self, $type, $kv, $rdata) = @_;
293 343
294 if ($type eq "node_hello") { 344 if ($type eq "node_hello") {
295 $self->{node_hello} = $kv; 345 $self->{node_hello} = $kv;
… …
297 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata) 347 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata)
298 and delete $self->{id}{$kv->{identifier}}; 348 and delete $self->{id}{$kv->{identifier}};
299 } 349 }
300} 350}
301 351
352=back
353
354=head2 FCP REQUESTS
355
356The following methods implement various requests. Most of them map
357directory to the FCP message of the same name. The added benefit of
358these over sending requests yourself is that they handle the necessary
359serialisation, protocol quirks, and replies.
360
361All of them exist in two versions, the variant shown in this manpage, and
362a variant with an extra C<_> at the end, and an extra C<$cb> argument. The
363version as shown is I<synchronous> - it will wait for any replies, and
364either return the reply, or croak with an error. The underscore variant
365returns immediately and invokes one or more callbacks or condvars later.
366
367For example, the call
368
369 $info = $fcp->get_plugin_info ($name, $detailed);
370
371Also comes in this underscore variant:
372
373 $fcp->get_plugin_info_ ($name, $detailed, $cb);
374
375You can thinbk of the underscore as a kind of continuation indicator - the
376normal function waits and returns with the data, the C<_> indicates that
377you pass the continuation yourself, and the continuation will be invoked
378with the results.
379
380This callback/continuation argument (C<$cb>) can come in three forms itself:
381
382=over 4
383
384=item A code reference (or rather anything not matching some other alternative)
385
386This code reference will be invoked with the result on success. On an
387error, it will die (in the event loop) with a backtrace of the call site.
388
389This is a popular choice, but it makes handling errors hard - make sure
390you never generate protocol errors!
391
392=item A condvar (as returned by e.g. C<< AnyEvent->condvar >>)
393
394When a condvar is passed, it is sent (C<< $cv->send ($results) >>) the
395results when the request has finished. Should an error occur, the error
396will instead result in C<< $cv->croak ($error) >>.
397
398This is also a popular choice.
399
400=item An array with two callbacks C<[$success, $failure]>
401
402The C<$success> callback will be invoked with the results, while the
403C<$failure> callback will be invoked on any errors.
404
405=item C<undef>
406
407This is the same thing as specifying C<sub { }> as callback, i.e. on
408success, the results are ignored, while on failure, you the module dies
409with a backtrace.
410
411This is good for quick scripts, or when you really aren't interested in
412the results.
413
414=back
415
416=cut
417
302our $NOP_CB = sub { }; 418our $NOP_CB = sub { };
303 419
304sub _txn { 420sub _txn {
305 my ($name, $sub) = @_; 421 my ($name, $sub) = @_;
306 422
307 *{$name} = sub { 423 *{$name} = sub {
308 splice @_, 1, 0, (my $cv = AnyEvent->condvar); 424 my $cv = AE::cv;
425
426 splice @_, 1, 0, $cv, sub { $cv->croak ($_[0]{extra_description}) };
309 &$sub; 427 &$sub;
310 $cv->recv 428 $cv->recv
311 }; 429 };
312 430
313 *{"$name\_"} = sub { 431 *{"$name\_"} = sub {
432 my ($ok, $err) = pop;
433
434 if (ARRAY:: eq ref $ok) {
435 ($ok, $err) = @$ok;
436 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) {
437 $err = sub { $ok->croak ($_[0]{extra_description}) };
438 } else {
439 my $bt = Carp::longmess "";
440 $err = sub {
441 die "$_[0]{code_description} ($_[0]{extra_description})$bt";
442 };
443 }
444
445 $ok ||= $NOP_CB;
446
314 splice @_, 1, 0, pop || $NOP_CB; 447 splice @_, 1, 0, $ok, $err;
315 &$sub; 448 &$sub;
316 }; 449 };
317} 450}
318 451
452=over 4
453
319=item $peers = $fcp->list_peers ([$with_metdata[, $with_volatile]]) 454=item $peers = $fcp->list_peers ([$with_metdata[, $with_volatile]])
320 455
321=cut 456=cut
322 457
323_txn list_peers => sub { 458_txn list_peers => sub {
324 my ($self, $cv, $with_metadata, $with_volatile) = @_; 459 my ($self, $ok, undef, $with_metadata, $with_volatile) = @_;
325 460
326 my @res; 461 my @res;
327 462
328 $self->send_msg (list_peers => 463 $self->send_msg (list_peers =>
329 with_metadata => $with_metadata ? "true" : "false", 464 with_metadata => $with_metadata ? "true" : "false",
330 with_volatile => $with_volatile ? "true" : "false", 465 with_volatile => $with_volatile ? "true" : "false",
331 id_cb => sub { 466 id_cb => sub {
332 my ($self, $type, $kv, $rdata) = @_; 467 my ($self, $type, $kv, $rdata) = @_;
333 468
334 if ($type eq "end_list_peers") { 469 if ($type eq "end_list_peers") {
335 $cv->(\@res); 470 $ok->(\@res);
336 1 471 1
337 } else { 472 } else {
338 push @res, $kv; 473 push @res, $kv;
339 0 474 0
340 } 475 }
… …
345=item $notes = $fcp->list_peer_notes ($node_identifier) 480=item $notes = $fcp->list_peer_notes ($node_identifier)
346 481
347=cut 482=cut
348 483
349_txn list_peer_notes => sub { 484_txn list_peer_notes => sub {
350 my ($self, $cv, $node_identifier) = @_; 485 my ($self, $ok, undef, $node_identifier) = @_;
351 486
352 $self->send_msg (list_peer_notes => 487 $self->send_msg (list_peer_notes =>
353 node_identifier => $node_identifier, 488 node_identifier => $node_identifier,
354 id_cb => sub { 489 id_cb => sub {
355 my ($self, $type, $kv, $rdata) = @_; 490 my ($self, $type, $kv, $rdata) = @_;
356 491
357 $cv->($kv); 492 $ok->($kv);
358 1 493 1
359 }, 494 },
360 ); 495 );
361}; 496};
362 497
363=item $fcp->watch_global ($enabled[, $verbosity_mask]) 498=item $fcp->watch_global ($enabled[, $verbosity_mask])
364 499
365=cut 500=cut
366 501
367_txn watch_global => sub { 502_txn watch_global => sub {
368 my ($self, $cv, $enabled, $verbosity_mask) = @_; 503 my ($self, $ok, $err, $enabled, $verbosity_mask) = @_;
369 504
370 $self->send_msg (watch_global => 505 $self->send_msg (watch_global =>
371 enabled => $enabled ? "true" : "false", 506 enabled => $enabled ? "true" : "false",
372 defined $verbosity_mask ? (verbosity_mask => $verbosity_mask+0) : (), 507 defined $verbosity_mask ? (verbosity_mask => $verbosity_mask+0) : (),
373 ); 508 );
374 509
375 $cv->(); 510 $ok->();
376}; 511};
377 512
378=item $reqs = $fcp->list_persistent_requests 513=item $reqs = $fcp->list_persistent_requests
379 514
380=cut 515=cut
381 516
382_txn list_persistent_requests => sub { 517_txn list_persistent_requests => sub {
383 my ($self, $cv) = @_; 518 my ($self, $ok, $err) = @_;
384 519
385 $self->serialise (list_persistent_requests => sub { 520 $self->serialise (list_persistent_requests => sub {
386 my ($self, $guard) = @_; 521 my ($self, $guard) = @_;
387 522
388 my @res; 523 my @res;
… …
393 my ($self, $type, $kv, $rdata) = @_; 528 my ($self, $type, $kv, $rdata) = @_;
394 529
395 $guard if 0; 530 $guard if 0;
396 531
397 if ($type eq "end_list_persistent_requests") { 532 if ($type eq "end_list_persistent_requests") {
398 $cv->(\@res); 533 $ok->(\@res);
399 return; 534 return;
400 } else { 535 } else {
401 my $id = $kv->{identifier}; 536 my $id = $kv->{identifier};
402 537
403 if ($type =~ /^persistent_(get|put|put_dir)$/) { 538 if ($type =~ /^persistent_(get|put|put_dir)$/) {
… …
408 1 543 1
409 }); 544 });
410 }); 545 });
411}; 546};
412 547
413=item $status = $fcp->remove_request ($global, $identifier) 548=item $sync = $fcp->modify_persistent_request ($global, $identifier[, $client_token[, $priority_class]])
414 549
415=cut 550Update either the C<client_token> or C<priority_class> of a request
551identified by C<$global> and C<$identifier>, depending on which of
552C<$client_token> and C<$priority_class> are not C<undef>.
416 553
417_txn remove_request => sub { 554=cut
418 my ($self, $cv, $global, $identifier) = @_;
419 555
556_txn modify_persistent_request => sub {
557 my ($self, $ok, $err, $global, $identifier, $client_token, $priority_class) = @_;
558
559 $self->serialise ($identifier => sub {
560 my ($self, $guard) = @_;
561
420 $self->send_msg (remove_request => 562 $self->send_msg (modify_persistent_request =>
421 global => $global ? "true" : "false", 563 global => $global ? "true" : "false",
422 identifier => $identifier, 564 identifier => $identifier,
423 id_cb => sub { 565 defined $client_token ? (client_token => $client_token ) : (),
566 defined $priority_class ? (priority_class => $priority_class) : (),
567 );
568
569 $self->on (sub {
424 my ($self, $type, $kv, $rdata) = @_; 570 my ($self, $type, $kv, @extra) = @_;
425 571
572 $guard if 0;
573
574 if ($kv->{identifier} eq $identifier) {
575 if ($type eq "persistent_request_modified") {
426 $cv->($kv); 576 $ok->($kv);
577 return;
578 } elsif ($type eq "protocol_error") {
579 $err->($kv);
580 return;
581 }
582 }
583
427 1 584 1
428 }, 585 });
429 ); 586 });
430}; 587};
431 588
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) 589=item $info = $fcp->get_plugin_info ($name, $detailed)
454 590
455=cut 591=cut
456 592
457_txn get_plugin_info => sub { 593_txn get_plugin_info => sub {
458 my ($self, $cv, $name, $detailed) = @_; 594 my ($self, $ok, $err, $name, $detailed) = @_;
595
596 my $id = $self->identifier;
459 597
460 $self->send_msg (get_plugin_info => 598 $self->send_msg (get_plugin_info =>
599 identifier => $id,
461 plugin_name => $name, 600 plugin_name => $name,
462 detailed => $detailed ? "true" : "false", 601 detailed => $detailed ? "true" : "false",
463 id_cb => sub {
464 my ($self, $type, $kv, $rdata) = @_;
465
466 $cv->($kv);
467 1
468 },
469 ); 602 );
603 $self->on (sub {
604 my ($self, $type, $kv) = @_;
605
606 if ($kv->{identifier} eq $id) {
607 if ($type eq "get_plugin_info") {
608 $ok->($kv);
609 } else {
610 $err->($kv, $type);
611 }
612 return;
613 }
614
615 1
616 });
470}; 617};
471 618
472=item $status = $fcp->client_get ($uri, $identifier, %kv) 619=item $status = $fcp->client_get ($uri, $identifier, %kv)
473 620
474%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>). 621%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>).
… …
478binary_blob, allowed_mime_types, filename, temp_filename 625binary_blob, allowed_mime_types, filename, temp_filename
479 626
480=cut 627=cut
481 628
482_txn client_get => sub { 629_txn client_get => sub {
483 my ($self, $cv, $uri, $identifier, %kv) = @_; 630 my ($self, $ok, $err, $uri, $identifier, %kv) = @_;
484 631
632 $self->serialise ($identifier => sub {
633 my ($self, $guard) = @_;
634
485 $self->send_msg (client_get => 635 $self->send_msg (client_get =>
486 %kv, 636 %kv,
487 uri => $uri, 637 uri => $uri,
488 identifier => $identifier, 638 identifier => $identifier,
639 );
640
641 $self->on (sub {
642 my ($self, $type, $kv, @extra) = @_;
643
644 $guard if 0;
645
646 if ($kv->{identifier} eq $identifier) {
647 if ($type eq "persistent_get") {
648 $ok->($kv);
649 return;
650 } elsif ($type eq "protocol_error") {
651 $err->($kv);
652 return;
653 }
654 }
655
656 1
657 });
489 ); 658 });
490}; 659};
491 660
492=item $status = $fcp->remove_request ($identifier[, $global]) 661=item $status = $fcp->remove_request ($identifier[, $global])
493 662
494Remove the request with the given isdentifier. Returns true if successful, 663Remove the request with the given isdentifier. Returns true if successful,
495false on error. 664false on error.
496 665
497=cut 666=cut
498 667
499_txn remove_request => sub { 668_txn remove_request => sub {
500 my ($self, $cv, $identifier, $global) = @_; 669 my ($self, $ok, $err, $identifier, $global) = @_;
501 670
502 $self->serialise ($identifier => sub { 671 $self->serialise ($identifier => sub {
503 my ($self, $guard) = @_; 672 my ($self, $guard) = @_;
504 673
505 $self->send_msg (remove_request => 674 $self->send_msg (remove_request =>
… …
507 global => $global ? "true" : "false", 676 global => $global ? "true" : "false",
508 ); 677 );
509 $self->on (sub { 678 $self->on (sub {
510 my ($self, $type, $kv, @extra) = @_; 679 my ($self, $type, $kv, @extra) = @_;
511 680
681 $guard if 0;
682
512 if ($kv->{identifier} eq $identifier) { 683 if ($kv->{identifier} eq $identifier) {
513 if ($type eq "persistent_request_removed") { 684 if ($type eq "persistent_request_removed") {
514 $cv->(1); 685 $ok->(1);
515 return; 686 return;
516 } elsif ($type eq "protocol_error") { 687 } elsif ($type eq "protocol_error") {
517 $cv->(undef); 688 $err->($kv);
518 return; 689 return;
519 } 690 }
520 } 691 }
521 692
522 1 693 1
… …
548directory. 719directory.
549 720
550=cut 721=cut
551 722
552_txn test_dda => sub { 723_txn test_dda => sub {
553 my ($self, $cv, $local, $remote, $want_read, $want_write) = @_; 724 my ($self, $ok, $err, $local, $remote, $want_read, $want_write) = @_;
554 725
555 $self->serialise (test_dda => sub { 726 $self->serialise (test_dda => sub {
556 my ($self, $guard) = @_; 727 my ($self, $guard) = @_;
557 728
558 $self->send_msg (test_dda_request => 729 $self->send_msg (test_dda_request =>
… …
599 my ($self, $type, $kv) = @_; 770 my ($self, $type, $kv) = @_;
600 771
601 $guard if 0; # reference 772 $guard if 0; # reference
602 773
603 if ($type eq "test_dda_complete") { 774 if ($type eq "test_dda_complete") {
604 $cv->( 775 $ok->(
605 $kv->{read_directory_allowed} eq "true", 776 $kv->{read_directory_allowed} eq "true",
606 $kv->{write_directory_allowed} eq "true", 777 $kv->{write_directory_allowed} eq "true",
607 ); 778 );
608 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) { 779 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) {
609 $cv->croak ($kv->{extra_description}); 780 $err->($kv->{extra_description});
610 return; 781 return;
611 } 782 }
612 783
613 1 784 1
614 }); 785 });
615 786
616 return; 787 return;
617 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) { 788 } elsif ($type eq "protocol_error" && $kv->{identifier} eq $remote) {
618 $cv->croak ($kv->{extra_description}); 789 $err->($kv);
619 return; 790 return;
620 } 791 }
621 792
622 1 793 1
623 }); 794 });

Diff Legend

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