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.178 by root, Tue Aug 11 01:15:17 2009 UTC vs.
Revision 1.188 by root, Thu Sep 17 08:20:14 2009 UTC

14 on_error => sub { 14 on_error => sub {
15 my ($hdl, $fatal, $msg) = @_; 15 my ($hdl, $fatal, $msg) = @_;
16 warn "got error $msg\n"; 16 warn "got error $msg\n";
17 $hdl->destroy; 17 $hdl->destroy;
18 $cv->send; 18 $cv->send;
19 ); 19 };
20 20
21 # send some request line 21 # send some request line
22 $hdl->push_write ("getinfo\015\012"); 22 $hdl->push_write ("getinfo\015\012");
23 23
24 # read the response line 24 # read the response line
60use AnyEvent (); BEGIN { AnyEvent::common_sense } 60use AnyEvent (); BEGIN { AnyEvent::common_sense }
61use AnyEvent::Util qw(WSAEWOULDBLOCK); 61use AnyEvent::Util qw(WSAEWOULDBLOCK);
62 62
63our $VERSION = $AnyEvent::VERSION; 63our $VERSION = $AnyEvent::VERSION;
64 64
65sub _load_func($) {
66 my $func = $_[0];
67
68 unless (defined &$func) {
69 my $pkg = $func;
70 do {
71 $pkg =~ s/::[^:]+$//
72 or return;
73 eval "require $pkg";
74 } until defined &$func;
75 }
76
77 \&$func
78}
79
65=head1 METHODS 80=head1 METHODS
66 81
67=over 4 82=over 4
68 83
69=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value... 84=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value...
114 129
115The actual numeric host and port (the socket peername) are passed as 130The actual numeric host and port (the socket peername) are passed as
116parameters, together with a retry callback. 131parameters, together with a retry callback.
117 132
118When, for some reason, the handle is not acceptable, then calling 133When, for some reason, the handle is not acceptable, then calling
119C<$retry> will continue with the next conenction target (in case of 134C<$retry> will continue with the next connection target (in case of
120multi-homed hosts or SRV records there can be multiple connection 135multi-homed hosts or SRV records there can be multiple connection
121endpoints). When it is called then the read and write queues, eof status, 136endpoints). At the time it is called the read and write queues, eof
122tls status and similar properties of the handle are being reset. 137status, tls status and similar properties of the handle will have been
138reset.
123 139
124In most cases, ignoring the C<$retry> parameter is the way to go. 140In most cases, ignoring the C<$retry> parameter is the way to go.
125 141
126=item on_connect_error => $cb->($handle, $message) 142=item on_connect_error => $cb->($handle, $message)
127 143
128This callback is called when the conenction could not be 144This callback is called when the connection could not be
129established. C<$!> will contain the relevant error code, and C<$message> a 145established. C<$!> will contain the relevant error code, and C<$message> a
130message describing it (usually the same as C<"$!">). 146message describing it (usually the same as C<"$!">).
131 147
132If this callback isn't specified, then C<on_error> will be called with a 148If this callback isn't specified, then C<on_error> will be called with a
133fatal error instead. 149fatal error instead.
285accomplishd by setting this option to a true value. 301accomplishd by setting this option to a true value.
286 302
287The default is your opertaing system's default behaviour (most likely 303The default is your opertaing system's default behaviour (most likely
288enabled), this option explicitly enables or disables it, if possible. 304enabled), this option explicitly enables or disables it, if possible.
289 305
306=item keepalive => <boolean>
307
308Enables (default disable) the SO_KEEPALIVE option on the stream socket:
309normally, TCP connections have no time-out once established, so TCP
310connections, once established, can stay alive forever even when the other
311side has long gone. TCP keepalives are a cheap way to take down long-lived
312TCP connections whent he other side becomes unreachable. While the default
313is OS-dependent, TCP keepalives usually kick in after around two hours,
314and, if the other side doesn't reply, take down the TCP connection some 10
315to 15 minutes later.
316
317It is harmless to specify this option for file handles that do not support
318keepalives, and enabling it on connections that are potentially long-lived
319is usually a good idea.
320
321=item oobinline => <boolean>
322
323BSD majorly fucked up the implementation of TCP urgent data. The result
324is that almost no OS implements TCP according to the specs, and every OS
325implements it slightly differently.
326
327If you want to handle TCP urgent data, then setting this flag (the default
328is enabled) gives you the most portable way of getting urgent data, by
329putting it into the stream.
330
331Since BSD emulation of OOB data on top of TCP's urgent data can have
332security implications, AnyEvent::Handle sets this flag automatically
333unless explicitly specified. Note that setting this flag after
334establishing a connection I<may> be a bit too late (data loss could
335already have occured on BSD systems), but at least it will protect you
336from most attacks.
337
290=item read_size => <bytes> 338=item read_size => <bytes>
291 339
292The default read block size (the amount of bytes this module will 340The default read block size (the amount of bytes this module will
293try to read during each loop iteration, which affects memory 341try to read during each loop iteration, which affects memory
294requirements). Default: C<8192>. 342requirements). Default: C<8192>.
327C<undef>. 375C<undef>.
328 376
329=item tls => "accept" | "connect" | Net::SSLeay::SSL object 377=item tls => "accept" | "connect" | Net::SSLeay::SSL object
330 378
331When this parameter is given, it enables TLS (SSL) mode, that means 379When this parameter is given, it enables TLS (SSL) mode, that means
332AnyEvent will start a TLS handshake as soon as the conenction has been 380AnyEvent will start a TLS handshake as soon as the connection has been
333established and will transparently encrypt/decrypt data afterwards. 381established and will transparently encrypt/decrypt data afterwards.
334 382
335All TLS protocol errors will be signalled as C<EPROTO>, with an 383All TLS protocol errors will be signalled as C<EPROTO>, with an
336appropriate error message. 384appropriate error message.
337 385
490 538
491 $self->{_activity} = 539 $self->{_activity} =
492 $self->{_ractivity} = 540 $self->{_ractivity} =
493 $self->{_wactivity} = AE::now; 541 $self->{_wactivity} = AE::now;
494 542
495 $self->timeout (delete $self->{timeout} ) if $self->{timeout}; 543 $self->timeout (delete $self->{timeout} ) if $self->{timeout};
496 $self->rtimeout (delete $self->{rtimeout}) if $self->{rtimeout}; 544 $self->rtimeout (delete $self->{rtimeout} ) if $self->{rtimeout};
497 $self->wtimeout (delete $self->{wtimeout}) if $self->{wtimeout}; 545 $self->wtimeout (delete $self->{wtimeout} ) if $self->{wtimeout};
498 546
499 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay}; 547 $self->no_delay (delete $self->{no_delay} ) if exists $self->{no_delay} && $self->{no_delay};
548 $self->keepalive (delete $self->{keepalive}) if exists $self->{keepalive} && $self->{keepalive};
500 549
550 $self->oobinline (exists $self->{oobinline} ? delete $self->{oobinline} : 1);
551
501 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) 552 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx})
502 if $self->{tls}; 553 if $self->{tls};
503 554
504 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 555 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
505 556
506 $self->start_read 557 $self->start_read
507 if $self->{on_read} || @{ $self->{_queue} }; 558 if $self->{on_read} || @{ $self->{_queue} };
508 559
509 $self->_drain_wbuf; 560 $self->_drain_wbuf;
516 $message ||= "$!"; 567 $message ||= "$!";
517 568
518 if ($self->{on_error}) { 569 if ($self->{on_error}) {
519 $self->{on_error}($self, $fatal, $message); 570 $self->{on_error}($self, $fatal, $message);
520 $self->destroy if $fatal; 571 $self->destroy if $fatal;
521 } elsif ($self->{fh}) { 572 } elsif ($self->{fh} || $self->{connect}) {
522 $self->destroy; 573 $self->destroy;
523 Carp::croak "AnyEvent::Handle uncaught error: $message"; 574 Carp::croak "AnyEvent::Handle uncaught error: $message";
524 } 575 }
525} 576}
526 577
587sub no_delay { 638sub no_delay {
588 $_[0]{no_delay} = $_[1]; 639 $_[0]{no_delay} = $_[1];
589 640
590 eval { 641 eval {
591 local $SIG{__DIE__}; 642 local $SIG{__DIE__};
592 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1] 643 setsockopt $_[0]{fh}, Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), int $_[1]
644 if $_[0]{fh};
645 };
646}
647
648=item $handle->keepalive ($boolean)
649
650Enables or disables the C<keepalive> setting (see constructor argument of
651the same name for details).
652
653=cut
654
655sub keepalive {
656 $_[0]{keepalive} = $_[1];
657
658 eval {
659 local $SIG{__DIE__};
660 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1]
661 if $_[0]{fh};
662 };
663}
664
665=item $handle->oobinline ($boolean)
666
667Enables or disables the C<oobinline> setting (see constructor argument of
668the same name for details).
669
670=cut
671
672sub oobinline {
673 $_[0]{oobinline} = $_[1];
674
675 eval {
676 local $SIG{__DIE__};
677 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_OOBINLINE (), int $_[1]
678 if $_[0]{fh};
679 };
680}
681
682=item $handle->keepalive ($boolean)
683
684Enables or disables the C<keepalive> setting (see constructor argument of
685the same name for details).
686
687=cut
688
689sub keepalive {
690 $_[0]{keepalive} = $_[1];
691
692 eval {
693 local $SIG{__DIE__};
694 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1]
593 if $_[0]{fh}; 695 if $_[0]{fh};
594 }; 696 };
595} 697}
596 698
597=item $handle->on_starttls ($cb) 699=item $handle->on_starttls ($cb)
785 }; 887 };
786} 888}
787 889
788our %WH; 890our %WH;
789 891
892# deprecated
790sub register_write_type($$) { 893sub register_write_type($$) {
791 $WH{$_[0]} = $_[1]; 894 $WH{$_[0]} = $_[1];
792} 895}
793 896
794sub push_write { 897sub push_write {
795 my $self = shift; 898 my $self = shift;
796 899
797 if (@_ > 1) { 900 if (@_ > 1) {
798 my $type = shift; 901 my $type = shift;
799 902
903 @_ = ($WH{$type} ||= _load_func "$type\::anyevent_write_type"
800 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write") 904 or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::push_write")
801 ->($self, @_); 905 ->($self, @_);
802 } 906 }
803 907
804 if ($self->{tls}) { 908 if ($self->{tls}) {
805 $self->{_tls_wbuf} .= $_[0]; 909 $self->{_tls_wbuf} .= $_[0];
810 } 914 }
811} 915}
812 916
813=item $handle->push_write (type => @args) 917=item $handle->push_write (type => @args)
814 918
815Instead of formatting your data yourself, you can also let this module do 919Instead of formatting your data yourself, you can also let this module
816the job by specifying a type and type-specific arguments. 920do the job by specifying a type and type-specific arguments. You
921can also specify the (fully qualified) name of a package, in which
922case AnyEvent tries to load the package and then expects to find the
923C<anyevent_read_type> function inside (see "custom write types", below).
817 924
818Predefined types are (if you have ideas for additional types, feel free to 925Predefined types are (if you have ideas for additional types, feel free to
819drop by and tell us): 926drop by and tell us):
820 927
821=over 4 928=over 4
878Other languages could read single lines terminated by a newline and pass 985Other languages could read single lines terminated by a newline and pass
879this line into their JSON decoder of choice. 986this line into their JSON decoder of choice.
880 987
881=cut 988=cut
882 989
990sub json_coder() {
991 eval { require JSON::XS; JSON::XS->new->utf8 }
992 || do { require JSON; JSON->new->utf8 }
993}
994
883register_write_type json => sub { 995register_write_type json => sub {
884 my ($self, $ref) = @_; 996 my ($self, $ref) = @_;
885 997
886 require JSON; 998 my $json = $self->{json} ||= json_coder;
887 999
888 $self->{json} ? $self->{json}->encode ($ref) 1000 $json->encode ($ref)
889 : JSON::encode_json ($ref)
890}; 1001};
891 1002
892=item storable => $reference 1003=item storable => $reference
893 1004
894Freezes the given reference using L<Storable> and writes it to the 1005Freezes the given reference using L<Storable> and writes it to the
929 1040
930 delete $self->{low_water_mark}; 1041 delete $self->{low_water_mark};
931 $self->on_drain (sub { shutdown $_[0]{fh}, 1 }); 1042 $self->on_drain (sub { shutdown $_[0]{fh}, 1 });
932} 1043}
933 1044
934=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 1045=item custom write types - Package::anyevent_write_type $handle, @args
935 1046
936This function (not method) lets you add your own types to C<push_write>. 1047Instead of one of the predefined types, you can also specify the name of
1048a package. AnyEvent will try to load the package and then expects to find
1049a function named C<anyevent_write_type> inside. If it isn't found, it
1050progressively tries to load the parent package until it either finds the
1051function (good) or runs out of packages (bad).
1052
937Whenever the given C<type> is used, C<push_write> will invoke the code 1053Whenever the given C<type> is used, C<push_write> will the function with
938reference with the handle object and the remaining arguments. 1054the handle object and the remaining arguments.
939 1055
940The code reference is supposed to return a single octet string that will 1056The function is supposed to return a single octet string that will be
941be appended to the write buffer. 1057appended to the write buffer, so you cna mentally treat this function as a
1058"arguments to on-the-wire-format" converter.
942 1059
943Note that this is a function, and all types registered this way will be 1060Example: implement a custom write type C<join> that joins the remaining
944global, so try to use unique names. 1061arguments using the first one.
1062
1063 $handle->push_write (My::Type => " ", 1,2,3);
1064
1065 # uses the following package, which can be defined in the "My::Type" or in
1066 # the "My" modules to be auto-loaded, or just about anywhere when the
1067 # My::Type::anyevent_write_type is defined before invoking it.
1068
1069 package My::Type;
1070
1071 sub anyevent_write_type {
1072 my ($handle, $delim, @args) = @_;
1073
1074 join $delim, @args
1075 }
945 1076
946=cut 1077=cut
947 1078
948############################################################################# 1079#############################################################################
949 1080
1168 my $cb = pop; 1299 my $cb = pop;
1169 1300
1170 if (@_) { 1301 if (@_) {
1171 my $type = shift; 1302 my $type = shift;
1172 1303
1304 $cb = ($RH{$type} ||= _load_func "$type\::anyevent_read_type"
1173 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 1305 or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::push_read")
1174 ->($self, $cb, @_); 1306 ->($self, $cb, @_);
1175 } 1307 }
1176 1308
1177 push @{ $self->{_queue} }, $cb; 1309 push @{ $self->{_queue} }, $cb;
1178 $self->_drain_rbuf; 1310 $self->_drain_rbuf;
1187 1319
1188 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read") 1320 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
1189 ->($self, $cb, @_); 1321 ->($self, $cb, @_);
1190 } 1322 }
1191 1323
1192
1193 unshift @{ $self->{_queue} }, $cb; 1324 unshift @{ $self->{_queue} }, $cb;
1194 $self->_drain_rbuf; 1325 $self->_drain_rbuf;
1195} 1326}
1196 1327
1197=item $handle->push_read (type => @args, $cb) 1328=item $handle->push_read (type => @args, $cb)
1198 1329
1199=item $handle->unshift_read (type => @args, $cb) 1330=item $handle->unshift_read (type => @args, $cb)
1200 1331
1201Instead of providing a callback that parses the data itself you can chose 1332Instead of providing a callback that parses the data itself you can chose
1202between a number of predefined parsing formats, for chunks of data, lines 1333between a number of predefined parsing formats, for chunks of data, lines
1203etc. 1334etc. You can also specify the (fully qualified) name of a package, in
1335which case AnyEvent tries to load the package and then expects to find the
1336C<anyevent_read_type> function inside (see "custom read types", below).
1204 1337
1205Predefined types are (if you have ideas for additional types, feel free to 1338Predefined types are (if you have ideas for additional types, feel free to
1206drop by and tell us): 1339drop by and tell us):
1207 1340
1208=over 4 1341=over 4
1448=cut 1581=cut
1449 1582
1450register_read_type json => sub { 1583register_read_type json => sub {
1451 my ($self, $cb) = @_; 1584 my ($self, $cb) = @_;
1452 1585
1453 my $json = $self->{json} ||= 1586 my $json = $self->{json} ||= json_coder;
1454 eval { require JSON::XS; JSON::XS->new->utf8 }
1455 || do { require JSON; JSON->new->utf8 };
1456 1587
1457 my $data; 1588 my $data;
1458 my $rbuf = \$self->{rbuf}; 1589 my $rbuf = \$self->{rbuf};
1459 1590
1460 sub { 1591 sub {
1529 } 1660 }
1530}; 1661};
1531 1662
1532=back 1663=back
1533 1664
1534=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args) 1665=item custom read types - Package::anyevent_read_type $handle, $cb, @args
1535 1666
1536This function (not method) lets you add your own types to C<push_read>. 1667Instead of one of the predefined types, you can also specify the name
1668of a package. AnyEvent will try to load the package and then expects to
1669find a function named C<anyevent_read_type> inside. If it isn't found, it
1670progressively tries to load the parent package until it either finds the
1671function (good) or runs out of packages (bad).
1537 1672
1538Whenever the given C<type> is used, C<push_read> will invoke the code 1673Whenever this type is used, C<push_read> will invoke the function with the
1539reference with the handle object, the callback and the remaining 1674handle object, the original callback and the remaining arguments.
1540arguments.
1541 1675
1542The code reference is supposed to return a callback (usually a closure) 1676The function is supposed to return a callback (usually a closure) that
1543that works as a plain read callback (see C<< ->push_read ($cb) >>). 1677works as a plain read callback (see C<< ->push_read ($cb) >>), so you can
1678mentally treat the function as a "configurable read type to read callback"
1679converter.
1544 1680
1545It should invoke the passed callback when it is done reading (remember to 1681It should invoke the original callback when it is done reading (remember
1546pass C<$handle> as first argument as all other callbacks do that). 1682to pass C<$handle> as first argument as all other callbacks do that,
1683although there is no strict requirement on this).
1547 1684
1548Note that this is a function, and all types registered this way will be
1549global, so try to use unique names.
1550
1551For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>, 1685For examples, see the source of this module (F<perldoc -m
1552search for C<register_read_type>)). 1686AnyEvent::Handle>, search for C<register_read_type>)).
1553 1687
1554=item $handle->stop_read 1688=item $handle->stop_read
1555 1689
1556=item $handle->start_read 1690=item $handle->start_read
1557 1691
1734 require Net::SSLeay; 1868 require Net::SSLeay;
1735 1869
1736 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 1870 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1737 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 1871 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1738 1872
1739 $tls = $self->{tls}; 1873 $tls = delete $self->{tls};
1740 $ctx = $self->{tls_ctx}; 1874 $ctx = $self->{tls_ctx};
1741 1875
1742 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session 1876 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1743 1877
1744 if ("HASH" eq ref $ctx) { 1878 if ("HASH" eq ref $ctx) {

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines