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

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.9 by root, Fri May 2 16:07:46 2008 UTC vs.
Revision 1.22 by root, Sat May 24 15:10:48 2008 UTC

… …
10use Fcntl (); 10use Fcntl ();
11use Errno qw/EAGAIN EINTR/; 11use Errno qw/EAGAIN EINTR/;
12 12
13=head1 NAME 13=head1 NAME
14 14
15AnyEvent::Handle - non-blocking I/O on filehandles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 16
17=cut 17This module is experimental.
18 18
19=cut
20
19our $VERSION = '0.02'; 21our $VERSION = '0.04';
20 22
21=head1 SYNOPSIS 23=head1 SYNOPSIS
22 24
23 use AnyEvent; 25 use AnyEvent;
24 use AnyEvent::Handle; 26 use AnyEvent::Handle;
… …
43 $cv->wait; 45 $cv->wait;
44 46
45=head1 DESCRIPTION 47=head1 DESCRIPTION
46 48
47This module is a helper module to make it easier to do event-based I/O on 49This module is a helper module to make it easier to do event-based I/O on
48filehandles (and sockets, see L<AnyEvent::Socket> for an easy way to make 50filehandles. For utility functions for doing non-blocking connects and accepts
49non-blocking resolves and connects). 51on sockets see L<AnyEvent::Util>.
50 52
51In the following, when the documentation refers to of "bytes" then this 53In the following, when the documentation refers to of "bytes" then this
52means characters. As sysread and syswrite are used for all I/O, their 54means characters. As sysread and syswrite are used for all I/O, their
53treatment of characters applies to this module as well. 55treatment of characters applies to this module as well.
54 56
… …
70The filehandle this L<AnyEvent::Handle> object will operate on. 72The filehandle this L<AnyEvent::Handle> object will operate on.
71 73
72NOTE: The filehandle will be set to non-blocking (using 74NOTE: The filehandle will be set to non-blocking (using
73AnyEvent::Util::fh_nonblocking). 75AnyEvent::Util::fh_nonblocking).
74 76
77=item on_eof => $cb->($self)
78
79Set the callback to be called on EOF.
80
81While not mandatory, it is highly recommended to set an eof callback,
82otherwise you might end up with a closed socket while you are still
83waiting for data.
84
75=item on_error => $cb->($self) [MANDATORY] 85=item on_error => $cb->($self)
76 86
77This is the fatal error callback, that is called when a fatal error ocurs, 87This is the fatal error callback, that is called when, well, a fatal error
78such as not being able to resolve the hostname, failure to connect or a 88occurs, such as not being able to resolve the hostname, failure to connect
79read error. 89or a read error.
80 90
81The object will not be in a usable state when this callback has been 91The object will not be in a usable state when this callback has been
82called. 92called.
83 93
84On callback entrance, the value of C<$!> contains the opertaing system 94On callback entrance, the value of C<$!> contains the operating system
85error (or C<ENOSPC> or C<EPIPE>). 95error (or C<ENOSPC> or C<EPIPE>).
86 96
87=item on_eof => $cb->($self) [MANDATORY] 97While not mandatory, it is I<highly> recommended to set this callback, as
88 98you will not be notified of errors otherwise. The default simply calls
89Set the callback to be called on EOF. 99die.
90 100
91=item on_read => $cb->($self) 101=item on_read => $cb->($self)
92 102
93This sets the default read callback, which is called when data arrives 103This sets the default read callback, which is called when data arrives
94and no read request is in the queue. If the read callback is C<undef> 104and no read request is in the queue.
95or has never been set, than AnyEvent::Handle will cease reading from the
96filehandle.
97 105
98To access (and remove data from) the read buffer, use the C<< ->rbuf >> 106To access (and remove data from) the read buffer, use the C<< ->rbuf >>
99method or acces sthe C<$self->{rbuf}> member directly. 107method or access the C<$self->{rbuf}> member directly.
100 108
101When an EOF condition is detected then AnyEvent::Handle will first try to 109When an EOF condition is detected then AnyEvent::Handle will first try to
102feed all the remaining data to the queued callbacks and C<on_read> before 110feed all the remaining data to the queued callbacks and C<on_read> before
103calling the C<on_eof> callback. If no progress can be made, then a fatal 111calling the C<on_eof> callback. If no progress can be made, then a fatal
104error will be raised (with C<$!> set to C<EPIPE>). 112error will be raised (with C<$!> set to C<EPIPE>).
… …
131 139
132Sets the amount of bytes (default: C<0>) that make up an "empty" write 140Sets the amount of bytes (default: C<0>) that make up an "empty" write
133buffer: If the write reaches this size or gets even samller it is 141buffer: If the write reaches this size or gets even samller it is
134considered empty. 142considered empty.
135 143
144=item tls => "accept" | "connect" | Net::SSLeay::SSL object
145
146When this parameter is given, it enables TLS (SSL) mode, that means it
147will start making tls handshake and will transparently encrypt/decrypt
148data.
149
150For the TLS server side, use C<accept>, and for the TLS client side of a
151connection, use C<connect> mode.
152
153You can also provide your own TLS connection object, but you have
154to make sure that you call either C<Net::SSLeay::set_connect_state>
155or C<Net::SSLeay::set_accept_state> on it before you pass it to
156AnyEvent::Handle.
157
158=item tls_ctx => $ssl_ctx
159
160Use the given Net::SSLeay::CTX object to create the new TLS connection
161(unless a connection object was specified directly). If this parameter is
162missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
163
136=back 164=back
137 165
138=cut 166=cut
139 167
140sub new { 168sub new {
… …
144 172
145 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 173 $self->{fh} or Carp::croak "mandatory argument fh is missing";
146 174
147 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 175 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
148 176
149 $self->on_error ((delete $self->{on_error}) or Carp::croak "mandatory argument on_error is missing"); 177 if ($self->{tls}) {
150 $self->on_eof ((delete $self->{on_eof} ) or Carp::croak "mandatory argument on_eof is missing"); 178 require Net::SSLeay;
179 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
180 }
151 181
182 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};
183 $self->on_error (delete $self->{on_error}) if $self->{on_error};
152 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 184 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
153 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 185 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
186
187 $self->start_read;
154 188
155 $self 189 $self
156} 190}
157 191
158sub _shutdown { 192sub _shutdown {
… …
169 { 203 {
170 local $!; 204 local $!;
171 $self->_shutdown; 205 $self->_shutdown;
172 } 206 }
173 207
208 if ($self->{on_error}) {
174 $self->{on_error}($self); 209 $self->{on_error}($self);
210 } else {
211 die "AnyEvent::Handle uncaught fatal error: $!";
212 }
175} 213}
176 214
177=item $fh = $handle->fh 215=item $fh = $handle->fh
178 216
179This method returns the filehandle of the L<AnyEvent::Handle> object. 217This method returns the file handle of the L<AnyEvent::Handle> object.
180 218
181=cut 219=cut
182 220
183sub fh { $_[0]->{fh} } 221sub fh { $_[0]->{fh} }
184 222
… …
212for reading. 250for reading.
213 251
214The write queue is very simple: you can add data to its end, and 252The write queue is very simple: you can add data to its end, and
215AnyEvent::Handle will automatically try to get rid of it for you. 253AnyEvent::Handle will automatically try to get rid of it for you.
216 254
217When data could be writtena nd the write buffer is shorter then the low 255When data could be written and the write buffer is shorter then the low
218water mark, the C<on_drain> callback will be invoked. 256water mark, the C<on_drain> callback will be invoked.
219 257
220=over 4 258=over 4
221 259
222=item $handle->on_drain ($cb) 260=item $handle->on_drain ($cb)
… …
241want (only limited by the available memory), as C<AnyEvent::Handle> 279want (only limited by the available memory), as C<AnyEvent::Handle>
242buffers it independently of the kernel. 280buffers it independently of the kernel.
243 281
244=cut 282=cut
245 283
246sub push_write { 284sub _drain_wbuf {
247 my ($self, $data) = @_; 285 my ($self) = @_;
248
249 $self->{wbuf} .= $data;
250 286
251 unless ($self->{ww}) { 287 unless ($self->{ww}) {
252 Scalar::Util::weaken $self; 288 Scalar::Util::weaken $self;
253 my $cb = sub { 289 my $cb = sub {
254 my $len = syswrite $self->{fh}, $self->{wbuf}; 290 my $len = syswrite $self->{fh}, $self->{wbuf};
255 291
256 if ($len > 0) { 292 if ($len > 0) {
257 substr $self->{wbuf}, 0, $len, ""; 293 substr $self->{wbuf}, 0, $len, "";
258
259 294
260 $self->{on_drain}($self) 295 $self->{on_drain}($self)
261 if $self->{low_water_mark} >= length $self->{wbuf} 296 if $self->{low_water_mark} >= length $self->{wbuf}
262 && $self->{on_drain}; 297 && $self->{on_drain};
263 298
… …
269 304
270 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 305 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb);
271 306
272 $cb->($self); 307 $cb->($self);
273 }; 308 };
309}
310
311sub push_write {
312 my $self = shift;
313
314 if ($self->{filter_w}) {
315 $self->{filter_w}->($self, \$_[0]);
316 } else {
317 $self->{wbuf} .= $_[0];
318 $self->_drain_wbuf;
319 }
274} 320}
275 321
276############################################################################# 322#############################################################################
277 323
278=back 324=back
… …
349 ... 395 ...
350 }); 396 });
351 397
352=over 4 398=over 4
353 399
400=cut
401
354sub _drain_rbuf { 402sub _drain_rbuf {
355 my ($self) = @_; 403 my ($self) = @_;
356 404
405 if (
406 defined $self->{rbuf_max}
407 && $self->{rbuf_max} < length $self->{rbuf}
408 ) {
409 $! = &Errno::ENOSPC; return $self->error;
410 }
411
357 return if exists $self->{in_drain}; 412 return if $self->{in_drain};
358 local $self->{in_drain} = 1; 413 local $self->{in_drain} = 1;
359 414
360 while (my $len = length $self->{rbuf}) { 415 while (my $len = length $self->{rbuf}) {
361 no strict 'refs'; 416 no strict 'refs';
362 if (@{ $self->{queue} }) { 417 if (my $cb = shift @{ $self->{queue} }) {
363 if ($self->{queue}[0]($self)) { 418 if (!$cb->($self)) {
364 shift @{ $self->{queue} };
365 } elsif ($self->{eof}) { 419 if ($self->{eof}) {
366 # no progress can be made (not enough data and no data forthcoming) 420 # no progress can be made (not enough data and no data forthcoming)
367 $! = &Errno::EPIPE; return $self->error; 421 $! = &Errno::EPIPE; return $self->error;
368 } else { 422 }
423
424 unshift @{ $self->{queue} }, $cb;
369 return; 425 return;
370 } 426 }
371 } elsif ($self->{on_read}) { 427 } elsif ($self->{on_read}) {
372 $self->{on_read}($self); 428 $self->{on_read}($self);
373 429
… …
387 } 443 }
388 } 444 }
389 445
390 if ($self->{eof}) { 446 if ($self->{eof}) {
391 $self->_shutdown; 447 $self->_shutdown;
392 $self->{on_eof}($self); 448 $self->{on_eof}($self)
449 if $self->{on_eof};
393 } 450 }
394} 451}
395 452
396=item $handle->on_read ($cb) 453=item $handle->on_read ($cb)
397 454
… …
403 460
404sub on_read { 461sub on_read {
405 my ($self, $cb) = @_; 462 my ($self, $cb) = @_;
406 463
407 $self->{on_read} = $cb; 464 $self->{on_read} = $cb;
408
409 unless ($self->{rw} || $self->{eof}) {
410 Scalar::Util::weaken $self;
411
412 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
413 my $len = sysread $self->{fh}, $self->{rbuf}, $self->{read_size} || 8192, length $self->{rbuf};
414
415 if ($len > 0) {
416 if (exists $self->{rbuf_max}) {
417 if ($self->{rbuf_max} < length $self->{rbuf}) {
418 $! = &Errno::ENOSPC; return $self->error;
419 }
420 }
421
422 } elsif (defined $len) {
423 $self->{eof} = 1;
424 delete $self->{rw};
425
426 } elsif ($! != EAGAIN && $! != EINTR) {
427 return $self->error;
428 }
429
430 $self->_drain_rbuf;
431 });
432 }
433} 465}
434 466
435=item $handle->rbuf 467=item $handle->rbuf
436 468
437Returns the read buffer (as a modifiable lvalue). 469Returns the read buffer (as a modifiable lvalue).
… …
456Append the given callback to the end of the queue (C<push_read>) or 488Append the given callback to the end of the queue (C<push_read>) or
457prepend it (C<unshift_read>). 489prepend it (C<unshift_read>).
458 490
459The callback is called each time some additional read data arrives. 491The callback is called each time some additional read data arrives.
460 492
461It must check wether enough data is in the read buffer already. 493It must check whether enough data is in the read buffer already.
462 494
463If not enough data is available, it must return the empty list or a false 495If not enough data is available, it must return the empty list or a false
464value, in which case it will be called repeatedly until enough data is 496value, in which case it will be called repeatedly until enough data is
465available (or an error condition is detected). 497available (or an error condition is detected).
466 498
… …
495these C<$len> bytes will be passed to the callback. 527these C<$len> bytes will be passed to the callback.
496 528
497=cut 529=cut
498 530
499sub _read_chunk($$) { 531sub _read_chunk($$) {
500 my ($len, $cb) = @_; 532 my ($self, $len, $cb) = @_;
501 533
502 sub { 534 sub {
503 $len <= length $_[0]{rbuf} or return; 535 $len <= length $_[0]{rbuf} or return;
504 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 536 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
505 1 537 1
506 } 538 }
507} 539}
508 540
509sub push_read_chunk { 541sub push_read_chunk {
510 my ($self, $len, $cb) = @_;
511
512 $self->push_read (_read_chunk $len, $cb); 542 $_[0]->push_read (&_read_chunk);
513} 543}
514 544
515 545
516sub unshift_read_chunk { 546sub unshift_read_chunk {
517 my ($self, $len, $cb) = @_;
518
519 $self->unshift_read (_read_chunk $len, $cb); 547 $_[0]->unshift_read (&_read_chunk);
520} 548}
521 549
522=item $handle->push_read_line ([$eol, ]$cb->($self, $line, $eol)) 550=item $handle->push_read_line ([$eol, ]$cb->($self, $line, $eol))
523 551
524=item $handle->unshift_read_line ([$eol, ]$cb->($self, $line, $eol)) 552=item $handle->unshift_read_line ([$eol, ]$cb->($self, $line, $eol))
… …
544not marked by the end of line marker. 572not marked by the end of line marker.
545 573
546=cut 574=cut
547 575
548sub _read_line($$) { 576sub _read_line($$) {
577 my $self = shift;
549 my $cb = pop; 578 my $cb = pop;
550 my $eol = @_ ? shift : qr|(\015?\012)|; 579 my $eol = @_ ? shift : qr|(\015?\012)|;
551 my $pos; 580 my $pos;
552 581
553 $eol = qr|(\Q$eol\E)| unless ref $eol; 582 $eol = quotemeta $eol unless ref $eol;
554 $eol = qr|^(.*?)($eol)|; 583 $eol = qr|^(.*?)($eol)|s;
555 584
556 sub { 585 sub {
557 $_[0]{rbuf} =~ s/$eol// or return; 586 $_[0]{rbuf} =~ s/$eol// or return;
558 587
559 $cb->($1, $2); 588 $cb->($_[0], $1, $2);
560 1 589 1
561 } 590 }
562} 591}
563 592
564sub push_read_line { 593sub push_read_line {
594 $_[0]->push_read (&_read_line);
595}
596
597sub unshift_read_line {
598 $_[0]->unshift_read (&_read_line);
599}
600
601=item $handle->stop_read
602
603=item $handle->start_read
604
605In rare cases you actually do not want to read anything from the
606socket. In this case you can call C<stop_read>. Neither C<on_read> no
607any queued callbacks will be executed then. To start reading again, call
608C<start_read>.
609
610=cut
611
612sub stop_read {
613 my ($self) = @_;
614
615 delete $self->{rw};
616}
617
618sub start_read {
619 my ($self) = @_;
620
621 unless ($self->{rw} || $self->{eof}) {
622 Scalar::Util::weaken $self;
623
624 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
625 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
626 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
627
628 if ($len > 0) {
629 $self->{filter_r}
630 ? $self->{filter_r}->($self, $rbuf)
631 : $self->_drain_rbuf;
632
633 } elsif (defined $len) {
634 delete $self->{rw};
635 $self->{eof} = 1;
636 $self->_drain_rbuf;
637
638 } elsif ($! != EAGAIN && $! != EINTR) {
639 return $self->error;
640 }
641 });
642 }
643}
644
645sub _dotls {
646 my ($self) = @_;
647
648 if (length $self->{tls_wbuf}) {
649 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) {
650 substr $self->{tls_wbuf}, 0, $len, "";
651 }
652 }
653
654 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) {
655 $self->{wbuf} .= $buf;
656 $self->_drain_wbuf;
657 }
658
659 while () {
660 if (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
661 $self->{rbuf} .= $buf;
662 $self->_drain_rbuf;
663 } elsif (
664 (my $err = Net::SSLeay::get_error ($self->{tls}, -1))
665 != Net::SSLeay::ERROR_WANT_READ ()
666 ) {
667 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
668 $self->error;
669 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
670 $! = &Errno::EIO;
671 $self->error;
672 }
673
674 last;
675 # all others are fine for our purposes
676 } else {
677 last;
678 }
679 }
680}
681
682# TODO: maybe document...
683sub starttls {
684 my ($self, $ssl, $ctx) = @_;
685
686 if ($ssl eq "accept") {
687 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
688 Net::SSLeay::set_accept_state ($ssl);
689 } elsif ($ssl eq "connect") {
690 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
691 Net::SSLeay::set_connect_state ($ssl);
692 }
693
694 $self->{tls} = $ssl;
695
696 # basically, this is deep magic (because SSL_read should have the same issues)
697 # but the openssl maintainers basically said: "trust us, it just works".
698 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
699 # and mismaintained ssleay-module doesn't even offer them).
700 Net::SSLeay::CTX_set_mode ($self->{tls},
701 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
702 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
703
704 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
705 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
706
707 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio});
708
709 $self->{filter_w} = sub {
710 $_[0]{tls_wbuf} .= ${$_[1]};
711 &_dotls;
712 };
713 $self->{filter_r} = sub {
714 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]});
715 &_dotls;
716 };
717}
718
719sub DESTROY {
565 my $self = shift; 720 my $self = shift;
566 721
567 $self->push_read (&_read_line); 722 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
568} 723}
569 724
570sub unshift_read_line { 725=item AnyEvent::Handle::TLS_CTX
571 my $self = shift;
572 726
573 $self->unshift_read (&_read_line); 727This function creates and returns the Net::SSLeay::CTX object used by
728default for TLS mode.
729
730The context is created like this:
731
732 Net::SSLeay::load_error_strings;
733 Net::SSLeay::SSLeay_add_ssl_algorithms;
734 Net::SSLeay::randomize;
735
736 my $CTX = Net::SSLeay::CTX_new;
737
738 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
739
740=cut
741
742our $TLS_CTX;
743
744sub TLS_CTX() {
745 $TLS_CTX || do {
746 require Net::SSLeay;
747
748 Net::SSLeay::load_error_strings ();
749 Net::SSLeay::SSLeay_add_ssl_algorithms ();
750 Net::SSLeay::randomize ();
751
752 $TLS_CTX = Net::SSLeay::CTX_new ();
753
754 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
755
756 $TLS_CTX
757 }
574} 758}
575 759
576=back 760=back
577 761
578=head1 AUTHOR 762=head1 AUTHOR

Diff Legend

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