1# You may distribute under the terms of either the GNU General Public License 2# or the Artistic License (the same terms as Perl itself) 3# 4# (C) Paul Evans, 2011-2015 -- leonerd@leonerd.org.uk 5 6package IO::Async::Socket; 7 8use strict; 9use warnings; 10 11our $VERSION = '0.800'; 12 13use base qw( IO::Async::Handle ); 14 15use Errno qw( EAGAIN EWOULDBLOCK EINTR ); 16 17use Carp; 18 19=head1 NAME 20 21C<IO::Async::Socket> - event callbacks and send buffering for a socket 22filehandle 23 24=head1 SYNOPSIS 25 26 use IO::Async::Socket; 27 28 use IO::Async::Loop; 29 my $loop = IO::Async::Loop->new; 30 31 my $socket = IO::Async::Socket->new( 32 on_recv => sub { 33 my ( $self, $dgram, $addr ) = @_; 34 35 print "Received reply: $dgram\n", 36 $loop->stop; 37 }, 38 on_recv_error => sub { 39 my ( $self, $errno ) = @_; 40 die "Cannot recv - $errno\n"; 41 }, 42 ); 43 $loop->add( $socket ); 44 45 $socket->connect( 46 host => "some.host.here", 47 service => "echo", 48 socktype => 'dgram', 49 )->get; 50 51 $socket->send( "A TEST DATAGRAM" ); 52 53 $loop->run; 54 55=head1 DESCRIPTION 56 57This subclass of L<IO::Async::Handle> contains a socket filehandle. It 58provides a queue of outgoing data. It invokes the C<on_recv> handler when new 59data is received from the filehandle. Data may be sent to the filehandle by 60calling the C<send> method. 61 62It is primarily intended for C<SOCK_DGRAM> or C<SOCK_RAW> sockets (such as UDP 63or packet-capture); for C<SOCK_STREAM> sockets (such as TCP) an instance of 64L<IO::Async::Stream> is more appropriate. 65 66=head1 EVENTS 67 68The following events are invoked, either using subclass methods or CODE 69references in parameters: 70 71=head2 on_recv $data, $addr 72 73Invoke on receipt of a packet, datagram, or stream segment. 74 75The C<on_recv> handler is invoked once for each packet, datagram, or stream 76segment that is received. It is passed the data itself, and the sender's 77address. 78 79=head2 on_recv_error $errno 80 81Optional. Invoked when the C<recv> method on the receiving handle fails. 82 83=head2 on_send_error $errno 84 85Optional. Invoked when the C<send> method on the sending handle fails. 86 87The C<on_recv_error> and C<on_send_error> handlers are passed the value of 88C<$!> at the time the error occurred. (The C<$!> variable itself, by its 89nature, may have changed from the original error by the time this handler 90runs so it should always use the value passed in). 91 92If an error occurs when the corresponding error callback is not supplied, and 93there is not a subclass method for it, then the C<close> method is 94called instead. 95 96=head2 on_outgoing_empty 97 98Optional. Invoked when the sending data buffer becomes empty. 99 100=cut 101 102sub _init 103{ 104 my $self = shift; 105 106 $self->{recv_len} = 65536; 107 108 $self->SUPER::_init( @_ ); 109} 110 111=head1 PARAMETERS 112 113The following named parameters may be passed to C<new> or C<configure>: 114 115=head2 read_handle => IO 116 117The IO handle to receive from. Must implement C<fileno> and C<recv> methods. 118 119=head2 write_handle => IO 120 121The IO handle to send to. Must implement C<fileno> and C<send> methods. 122 123=head2 handle => IO 124 125Shortcut to specifying the same IO handle for both of the above. 126 127=head2 on_recv => CODE 128 129=head2 on_recv_error => CODE 130 131=head2 on_outgoing_empty => CODE 132 133=head2 on_send_error => CODE 134 135=head2 autoflush => BOOL 136 137Optional. If true, the C<send> method will atempt to send data to the 138operating system immediately, without waiting for the loop to indicate the 139filehandle is write-ready. 140 141=head2 recv_len => INT 142 143Optional. Sets the buffer size for C<recv> calls. Defaults to 64 KiB. 144 145=head2 recv_all => BOOL 146 147Optional. If true, repeatedly call C<recv> when the receiving handle first 148becomes read-ready. By default this is turned off, meaning at most one 149fixed-size buffer is received. If there is still more data in the kernel's 150buffer, the handle will stil be readable, and will be received from again. 151 152This behaviour allows multiple streams and sockets to be multiplexed 153simultaneously, meaning that a large bulk transfer on one cannot starve other 154filehandles of processing time. Turning this option on may improve bulk data 155transfer rate, at the risk of delaying or stalling processing on other 156filehandles. 157 158=head2 send_all => INT 159 160Optional. Analogous to the C<recv_all> option, but for sending. When 161C<autoflush> is enabled, this option only affects deferred sending if the 162initial attempt failed. 163 164The condition requiring an C<on_recv> handler is checked at the time the 165object is added to a Loop; it is allowed to create a C<IO::Async::Socket> 166object with a read handle but without a C<on_recv> handler, provided that 167one is later given using C<configure> before the stream is added to its 168containing Loop, either directly or by being a child of another Notifier 169already in a Loop, or added to one. 170 171=cut 172 173sub configure 174{ 175 my $self = shift; 176 my %params = @_; 177 178 for (qw( on_recv on_outgoing_empty on_recv_error on_send_error 179 recv_len recv_all send_all autoflush )) { 180 $self->{$_} = delete $params{$_} if exists $params{$_}; 181 } 182 183 $self->SUPER::configure( %params ); 184 185 if( $self->loop and defined $self->read_handle ) { 186 $self->can_event( "on_recv" ) or 187 croak 'Expected either an on_recv callback or to be able to ->on_recv'; 188 } 189} 190 191sub _add_to_loop 192{ 193 my $self = shift; 194 195 if( defined $self->read_handle ) { 196 $self->can_event( "on_recv" ) or 197 croak 'Expected either an on_recv callback or to be able to ->on_recv'; 198 } 199 200 $self->SUPER::_add_to_loop( @_ ); 201} 202 203=head1 METHODS 204 205=cut 206 207=head2 send 208 209 $socket->send( $data, $flags, $addr ) 210 211This method adds a segment of data to be sent, or sends it immediately, 212according to the C<autoflush> parameter. C<$flags> and C<$addr> are optional. 213 214If the C<autoflush> option is set, this method will try immediately to send 215the data to the underlying filehandle, optionally using the given flags and 216destination address. If this completes successfully then it will have been 217sent by the time this method returns. If it fails to send, then the data is 218queued as if C<autoflush> were not set, and will be flushed as normal. 219 220=cut 221 222sub send 223{ 224 my $self = shift; 225 my ( $data, $flags, $addr ) = @_; 226 227 croak "Cannot send data to a Socket with no write_handle" unless my $handle = $self->write_handle; 228 229 my $sendqueue = $self->{sendqueue} ||= []; 230 push @$sendqueue, [ $data, $flags, $addr ]; 231 232 if( $self->{autoflush} ) { 233 while( @$sendqueue ) { 234 my ( $data, $flags, $addr ) = @{ $sendqueue->[0] }; 235 my $len = $handle->send( $data, $flags, $addr ); 236 237 last if !$len; # stop on any errors and defer back to the non-autoflush path 238 239 shift @$sendqueue; 240 } 241 242 if( !@$sendqueue ) { 243 $self->want_writeready( 0 ); 244 return; 245 } 246 } 247 248 $self->want_writeready( 1 ); 249} 250 251sub on_read_ready 252{ 253 my $self = shift; 254 255 my $handle = $self->read_handle; 256 257 while(1) { 258 my $addr = $handle->recv( my $data, $self->{recv_len} ); 259 260 if( !defined $addr ) { 261 return if $! == EAGAIN || $! == EWOULDBLOCK || $! == EINTR; 262 263 my $errno = $!; 264 265 $self->maybe_invoke_event( on_recv_error => $errno ) 266 or $self->close; 267 268 return; 269 } 270 271 if( !length $data ) { 272 $self->close; 273 return; 274 } 275 276 $self->invoke_event( on_recv => $data, $addr ); 277 278 last unless $self->{recv_all}; 279 } 280} 281 282sub on_write_ready 283{ 284 my $self = shift; 285 286 my $handle = $self->write_handle; 287 288 my $sendqueue = $self->{sendqueue}; 289 290 while( $sendqueue and @$sendqueue ) { 291 my ( $data, $flags, $addr ) = @{ shift @$sendqueue }; 292 my $len = $handle->send( $data, $flags, $addr ); 293 294 if( !defined $len ) { 295 return if $! == EAGAIN || $! == EWOULDBLOCK || $! == EINTR; 296 297 my $errno = $!; 298 299 $self->maybe_invoke_event( on_send_error => $errno ) 300 or $self->close; 301 302 return; 303 } 304 305 if( $len == 0 ) { 306 $self->close; 307 return; 308 } 309 310 last unless $self->{send_all}; 311 } 312 313 if( !$sendqueue or !@$sendqueue ) { 314 $self->want_writeready( 0 ); 315 316 $self->maybe_invoke_event( on_outgoing_empty => ); 317 } 318} 319 320=head1 EXAMPLES 321 322=head2 Send-first on a UDP Socket 323 324C<UDP> is carried by the C<SOCK_DGRAM> socket type, for which the string 325C<'dgram'> is a convenient shortcut: 326 327 $socket->connect( 328 host => $hostname, 329 service => $service, 330 socktype => 'dgram', 331 ... 332 ) 333 334=head2 Receive-first on a UDP Socket 335 336A typical server pattern with C<UDP> involves binding a well-known port 337number instead of connecting to one, and waiting on incoming packets. 338 339 $socket->bind( 340 service => 12345, 341 socktype => 'dgram', 342 )->get; 343 344=head1 SEE ALSO 345 346=over 4 347 348=item * 349 350L<IO::Handle> - Supply object methods for I/O handles 351 352=back 353 354=head1 AUTHOR 355 356Paul Evans <leonerd@leonerd.org.uk> 357 358=cut 359 3600x55AA; 361