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.17 by root, Sat Sep 5 19:36:12 2015 UTC

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

Diff Legend

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