1package POE::Wheel::SocketFactory; 2 3use strict; 4 5use vars qw($VERSION @ISA); 6$VERSION = '1.368'; # NOTE - Should be #.### (three decimal places) 7 8use Carp qw( carp croak ); 9use Symbol qw( gensym ); 10 11use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); 12use Errno qw( 13 EWOULDBLOCK EADDRNOTAVAIL EINPROGRESS EADDRINUSE ECONNABORTED 14 ESPIPE 15); 16 17use Socket qw( 18 AF_INET SOCK_STREAM SOL_SOCKET AF_UNIX PF_UNIX 19 PF_INET SOCK_DGRAM SO_ERROR unpack_sockaddr_in 20 unpack_sockaddr_un PF_UNSPEC SO_REUSEADDR INADDR_ANY 21 pack_sockaddr_in pack_sockaddr_un inet_aton SOMAXCONN 22); 23 24use IO::Handle (); 25use FileHandle (); 26use POE qw( Wheel ); 27push @ISA, qw(POE::Wheel); 28 29sub CRIMSON_SCOPE_HACK ($) { 0 } 30sub DEBUG () { 0 } 31 32sub MY_SOCKET_HANDLE () { 0 } 33sub MY_UNIQUE_ID () { 1 } 34sub MY_EVENT_SUCCESS () { 2 } 35sub MY_EVENT_FAILURE () { 3 } 36sub MY_SOCKET_DOMAIN () { 4 } 37sub MY_STATE_ACCEPT () { 5 } 38sub MY_STATE_CONNECT () { 6 } 39sub MY_MINE_SUCCESS () { 7 } 40sub MY_MINE_FAILURE () { 8 } 41sub MY_SOCKET_PROTOCOL () { 9 } 42sub MY_SOCKET_TYPE () { 10 } 43sub MY_STATE_ERROR () { 11 } 44sub MY_SOCKET_SELECTED () { 12 } 45 46# Fletch has subclassed SSLSocketFactory from SocketFactory. 47# He's added new members after MY_SOCKET_SELECTED. Be sure, if you 48# extend this, to extend add stuff BEFORE MY_SOCKET_SELECTED or let 49# Fletch know you've broken his module. 50 51# If IPv6 support can't be loaded, then provide dummies so the code at 52# least compiles. Suggested in rt.cpan.org 27250. 53BEGIN { 54 55 eval { Socket->import( qw(getaddrinfo unpack_sockaddr_in6) ) }; 56 if ($@) { 57 *getaddrinfo = sub { Carp::confess("Unable to use IPv6: Socket doesn't provide getaddrinfo()") }; 58 *unpack_sockaddr_in6 = sub { Carp::confess("Unable to use IPv6: Socket doesn't provide unpack_sockaddr_in6()") }; 59 } 60 61 # Socket6 provides AF_INET6 and PF_INET6 where earlier Perls' Socket don't. 62 eval { Socket->import( qw(AF_INET6 PF_INET6) ) }; 63 if ($@) { 64 eval { require Socket6; Socket6->import( qw(AF_INET6 PF_INET6) ) }; 65 if ($@) { 66 *AF_INET6 = sub { -1 }; 67 *PF_INET6 = sub { -1 }; 68 } 69 } 70 71 eval { Socket->import( 'IPPROTO_TCP' ) }; 72 if ($@) { 73 *IPPROTO_TCP = (getprotobyname 'tcp')[2]; 74 } 75 76 eval { Socket->import( 'IPPROTO_UDP' ) }; 77 if ($@) { 78 *IPPROTO_UDP = (getprotobyname 'udp')[2]; 79 } 80} 81 82# Common protocols to help support systems that don't have 83# getprotobyname(). 84my %proto_by_name = ( 85 tcp => IPPROTO_TCP, 86 udp => IPPROTO_UDP, 87); 88 89my %proto_by_number = reverse %proto_by_name; 90 91#------------------------------------------------------------------------------ 92# These tables customize the socketfactory. Many protocols share the 93# same operations, it seems, and this is a way to add new ones with a 94# minimum of additional code. 95 96sub DOM_UNIX () { 'unix' } # UNIX domain socket 97sub DOM_INET () { 'inet' } # INET domain socket 98sub DOM_INET6 () { 'inet6' } # INET v6 domain socket 99 100# AF_XYZ and PF_XYZ may be different. 101my %map_family_to_domain = ( 102 AF_UNIX, DOM_UNIX, PF_UNIX, DOM_UNIX, 103 AF_INET, DOM_INET, PF_INET, DOM_INET, 104 AF_INET6, DOM_INET6, 105 PF_INET6, DOM_INET6, 106); 107 108sub SVROP_LISTENS () { 'listens' } # connect/listen sockets 109sub SVROP_NOTHING () { 'nothing' } # connectionless sockets 110 111# Map family/protocol pairs to connection or connectionless 112# operations. 113my %supported_protocol = ( 114 DOM_UNIX, { 115 none => SVROP_LISTENS 116 }, 117 DOM_INET, { 118 tcp => SVROP_LISTENS, 119 udp => SVROP_NOTHING, 120 }, 121 DOM_INET6, { 122 tcp => SVROP_LISTENS, 123 udp => SVROP_NOTHING, 124 }, 125); 126 127# Sane default socket types for each supported protocol. TODO Maybe 128# this structure can be combined with %supported_protocol? 129my %default_socket_type = ( 130 DOM_UNIX, { 131 none => SOCK_STREAM 132 }, 133 DOM_INET, { 134 tcp => SOCK_STREAM, 135 udp => SOCK_DGRAM, 136 }, 137 DOM_INET6, { 138 tcp => SOCK_STREAM, 139 udp => SOCK_DGRAM, 140 }, 141); 142 143#------------------------------------------------------------------------------ 144# Perform system-dependent translations on Unix addresses, if 145# necessary. 146 147sub _condition_unix_address { 148 my ($address) = @_; 149 150 # OS/2 would like sockets to use backwhacks, and please place them 151 # in the virtual \socket\ directory. Thank you. 152 if ($^O eq 'os2') { 153 $address =~ tr[\\][/]; 154 if ($address !~ m{^/socket/}) { 155 $address =~ s{^/?}{/socket/}; 156 } 157 $address =~ tr[/][\\]; 158 } 159 160 $address; 161} 162 163#------------------------------------------------------------------------------ 164# Define the select handler that will accept connections. 165 166sub _define_accept_state { 167 my $self = shift; 168 169 # We do these stupid closure tricks to avoid putting $self in it 170 # directly. If you include $self in one of the state() closures, 171 # the component will fail to shut down properly: there will be a 172 # circular definition in the closure holding $self alive. 173 174 my $domain = $map_family_to_domain{ $self->[MY_SOCKET_DOMAIN] }; 175 $domain = '(undef)' unless defined $domain; 176 my $event_success = \$self->[MY_EVENT_SUCCESS]; 177 my $event_failure = \$self->[MY_EVENT_FAILURE]; 178 my $unique_id = $self->[MY_UNIQUE_ID]; 179 180 $poe_kernel->state( 181 $self->[MY_STATE_ACCEPT] = ref($self) . "($unique_id) -> select accept", 182 sub { 183 # prevents SEGV 184 0 && CRIMSON_SCOPE_HACK('<'); 185 186 # subroutine starts here 187 my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0]; 188 189 my $new_socket = gensym; 190 my $peer = accept($new_socket, $handle); 191 192 if ($peer) { 193 my ($peer_addr, $peer_port); 194 if ( $domain eq DOM_UNIX ) { 195 $peer_port = undef; 196 eval { $peer_addr = unpack_sockaddr_un($peer) }; 197 $peer_addr = undef if length $@; 198 } 199 elsif ( $domain eq DOM_INET ) { 200 ($peer_port, $peer_addr) = unpack_sockaddr_in($peer); 201 } 202 elsif ( $domain eq DOM_INET6 ) { 203 ($peer_port, $peer_addr) = unpack_sockaddr_in6($peer); 204 } 205 else { 206 die "sanity failure: socket domain == $domain"; 207 } 208 $k->call( 209 $me, $$event_success, 210 $new_socket, $peer_addr, $peer_port, 211 $unique_id 212 ); 213 } 214 elsif ($! != EWOULDBLOCK and $! != ECONNABORTED and $! != ESPIPE) { 215 # OSX reports ESPIPE, which isn't documented anywhere. 216 $$event_failure && $k->call( 217 $me, $$event_failure, 218 'accept', ($!+0), $!, $unique_id 219 ); 220 } 221 } 222 ); 223 224 $self->[MY_SOCKET_SELECTED] = 'yes'; 225 $poe_kernel->select_read( 226 $self->[MY_SOCKET_HANDLE], 227 $self->[MY_STATE_ACCEPT] 228 ); 229} 230 231#------------------------------------------------------------------------------ 232# Define the select handler that will finalize an established 233# connection. 234 235sub _define_connect_state { 236 my $self = shift; 237 238 # We do these stupid closure tricks to avoid putting $self in it 239 # directly. If you include $self in one of the state() closures, 240 # the component will fail to shut down properly: there will be a 241 # circular definition in the closure holding $self alive. 242 243 my $domain = $map_family_to_domain{ $self->[MY_SOCKET_DOMAIN] }; 244 $domain = '(undef)' unless defined $domain; 245 my $event_success = \$self->[MY_EVENT_SUCCESS]; 246 my $event_failure = \$self->[MY_EVENT_FAILURE]; 247 my $unique_id = $self->[MY_UNIQUE_ID]; 248 my $socket_selected = \$self->[MY_SOCKET_SELECTED]; 249 250 my $socket_handle = \$self->[MY_SOCKET_HANDLE]; 251 my $state_accept = \$self->[MY_STATE_ACCEPT]; 252 my $state_connect = \$self->[MY_STATE_CONNECT]; 253 my $mine_success = \$self->[MY_MINE_SUCCESS]; 254 my $mine_failure = \$self->[MY_MINE_FAILURE]; 255 256 $poe_kernel->state( 257 $self->[MY_STATE_CONNECT] = ( 258 ref($self) . "($unique_id) -> select connect" 259 ), 260 sub { 261 # This prevents SEGV in older versions of Perl. 262 0 && CRIMSON_SCOPE_HACK('<'); 263 264 # Grab some values and stop watching the socket. 265 my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0]; 266 267 _shutdown( 268 $socket_selected, $socket_handle, 269 $state_accept, $state_connect, 270 $mine_success, $event_success, 271 $mine_failure, $event_failure, 272 ); 273 274 # Throw a failure if the connection failed. 275 $! = unpack('i', getsockopt($handle, SOL_SOCKET, SO_ERROR)); 276 if ($!) { 277 (defined $$event_failure) and $k->call( 278 $me, $$event_failure, 279 'connect', ($!+0), $!, $unique_id 280 ); 281 return; 282 } 283 284 # Get the remote address, or throw an error if that fails. 285 my $peer = getpeername($handle); 286 if ($!) { 287 (defined $$event_failure) and $k->call( 288 $me, $$event_failure, 289 'getpeername', ($!+0), $!, $unique_id 290 ); 291 return; 292 } 293 294 # Parse the remote address according to the socket's domain. 295 my ($peer_addr, $peer_port); 296 297 # UNIX sockets have some trouble with peer addresses. 298 if ($domain eq DOM_UNIX) { 299 if (defined $peer) { 300 eval { $peer_addr = unpack_sockaddr_un($peer) }; 301 $peer_addr = undef if length $@; 302 } 303 } 304 305 # INET socket stacks tend not to. 306 elsif ($domain eq DOM_INET) { 307 if (defined $peer) { 308 eval { 309 ($peer_port, $peer_addr) = unpack_sockaddr_in($peer); 310 }; 311 if (length $@) { 312 $peer_port = $peer_addr = undef; 313 } 314 } 315 } 316 317 # INET6 socket stacks tend not to. 318 elsif ($domain eq DOM_INET6) { 319 if (defined $peer) { 320 eval { 321 ($peer_port, $peer_addr) = unpack_sockaddr_in6($peer); 322 }; 323 if (length $@) { 324 $peer_port = $peer_addr = undef; 325 } 326 } 327 } 328 329 # What are we doing here? 330 else { 331 die "sanity failure: socket domain == $domain"; 332 } 333 334 # Tell the session it went okay. Also let go of the socket. 335 $k->call( 336 $me, $$event_success, 337 $handle, $peer_addr, $peer_port, $unique_id 338 ); 339 } 340 ); 341 342 # Cygwin and Windows expect an error state registered to expedite. 343 # This code is nearly identical the stuff above. 344 if ($^O eq "cygwin" or $^O eq "MSWin32") { 345 $poe_kernel->state( 346 $self->[MY_STATE_ERROR] = ( 347 ref($self) . "($unique_id) -> connect error" 348 ), 349 sub { 350 # This prevents SEGV in older versions of Perl. 351 0 && CRIMSON_SCOPE_HACK('<'); 352 353 # Grab some values and stop watching the socket. 354 my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0]; 355 356 _shutdown( 357 $socket_selected, $socket_handle, 358 $state_accept, $state_connect, 359 $mine_success, $event_success, 360 $mine_failure, $event_failure, 361 ); 362 363 # Throw a failure if the connection failed. 364 $! = unpack('i', getsockopt($handle, SOL_SOCKET, SO_ERROR)); 365 if ($!) { 366 (defined $$event_failure) and $k->call( 367 $me, $$event_failure, 'connect', ($!+0), $!, $unique_id 368 ); 369 return; 370 } 371 } 372 ); 373 $poe_kernel->select_expedite( 374 $self->[MY_SOCKET_HANDLE], 375 $self->[MY_STATE_ERROR] 376 ); 377 } 378 379 $self->[MY_SOCKET_SELECTED] = 'yes'; 380 $poe_kernel->select_write( 381 $self->[MY_SOCKET_HANDLE], 382 $self->[MY_STATE_CONNECT] 383 ); 384} 385 386#------------------------------------------------------------------------------ 387 388sub event { 389 my $self = shift; 390 push(@_, undef) if (scalar(@_) & 1); 391 392 while (@_) { 393 my ($name, $event) = splice(@_, 0, 2); 394 395 if ($name eq 'SuccessEvent') { 396 if (defined $event) { 397 if (ref($event)) { 398 carp "reference for SuccessEvent will be treated as an event name" 399 } 400 $self->[MY_EVENT_SUCCESS] = $event; 401 undef $self->[MY_MINE_SUCCESS]; 402 } 403 else { 404 carp "SuccessEvent requires an event name. ignoring undef"; 405 } 406 } 407 elsif ($name eq 'FailureEvent') { 408 if (defined $event) { 409 if (ref($event)) { 410 carp "reference for FailureEvent will be treated as an event name"; 411 } 412 $self->[MY_EVENT_FAILURE] = $event; 413 undef $self->[MY_MINE_FAILURE]; 414 } 415 else { 416 carp "FailureEvent requires an event name. ignoring undef"; 417 } 418 } 419 else { 420 carp "ignoring unknown SocketFactory parameter '$name'"; 421 } 422 } 423 424 $self->[MY_SOCKET_SELECTED] = 'yes'; 425 if (defined $self->[MY_STATE_ACCEPT]) { 426 $poe_kernel->select_read( 427 $self->[MY_SOCKET_HANDLE], 428 $self->[MY_STATE_ACCEPT] 429 ); 430 } 431 elsif (defined $self->[MY_STATE_CONNECT]) { 432 $poe_kernel->select_write( 433 $self->[MY_SOCKET_HANDLE], 434 $self->[MY_STATE_CONNECT] 435 ); 436 if ($^O eq "cygwin" or $^O eq "MSWin32") { 437 $poe_kernel->select_expedite( 438 $self->[MY_SOCKET_HANDLE], 439 $self->[MY_STATE_ERROR] 440 ); 441 } 442 } 443 else { 444 die "POE developer error - no state defined"; 445 } 446} 447 448#------------------------------------------------------------------------------ 449 450sub getsockname { 451 my $self = shift; 452 return undef unless ( 453 defined $self->[MY_SOCKET_HANDLE] and 454 fileno($self->[MY_SOCKET_HANDLE]) 455 ); 456 return getsockname($self->[MY_SOCKET_HANDLE]); 457} 458 459sub ID { 460 return $_[0]->[MY_UNIQUE_ID]; 461} 462 463#------------------------------------------------------------------------------ 464 465sub new { 466 my $type = shift; 467 468 # Don't take responsibility for a bad parameter count. 469 croak "$type requires an even number of parameters" if @_ & 1; 470 471 my %params = @_; 472 473 # The calling convention experienced a hard deprecation. 474 croak "wheels no longer require a kernel reference as their first parameter" 475 if (@_ && (ref($_[0]) eq 'POE::Kernel')); 476 477 # Ensure some of the basic things are present. 478 croak "$type requires a working Kernel" unless (defined $poe_kernel); 479 croak 'SuccessEvent required' unless (defined $params{SuccessEvent}); 480 croak 'FailureEvent required' unless (defined $params{FailureEvent}); 481 my $event_success = $params{SuccessEvent}; 482 my $event_failure = $params{FailureEvent}; 483 484 # Create the SocketServer. Cache a copy of the socket handle. 485 my $socket_handle = gensym(); 486 my $self = bless( 487 [ 488 $socket_handle, # MY_SOCKET_HANDLE 489 &POE::Wheel::allocate_wheel_id(), # MY_UNIQUE_ID 490 $event_success, # MY_EVENT_SUCCESS 491 $event_failure, # MY_EVENT_FAILURE 492 undef, # MY_SOCKET_DOMAIN 493 undef, # MY_STATE_ACCEPT 494 undef, # MY_STATE_CONNECT 495 undef, # MY_MINE_SUCCESS 496 undef, # MY_MINE_FAILURE 497 undef, # MY_SOCKET_PROTOCOL 498 undef, # MY_SOCKET_TYPE 499 undef, # MY_STATE_ERROR 500 undef, # MY_SOCKET_SELECTED 501 ], 502 $type 503 ); 504 505 # Default to Internet sockets. 506 my $domain = delete $params{SocketDomain}; 507 if (defined $domain) { 508 # [rt.cpan.org 76314] Untaint the domain. 509 ($domain) = ($domain =~ /\A(.*)\z/s); 510 } 511 else { 512 $domain = AF_INET; 513 } 514 $self->[MY_SOCKET_DOMAIN] = $domain; 515 516 # Abstract the socket domain into something we don't have to keep 517 # testing duplicates of. 518 my $abstract_domain = $map_family_to_domain{$self->[MY_SOCKET_DOMAIN]}; 519 unless (defined $abstract_domain) { 520 $poe_kernel->yield( 521 $event_failure, 522 'domain', 523 0, 524 "SocketDomain $domain is currently unsupported on this platform", 525 $self->[MY_UNIQUE_ID] 526 ); 527 return $self; 528 } 529 530 #---------------# 531 # Create Socket # 532 #---------------# 533 534 # Declare the protocol name out here; it'll be needed by 535 # getservbyname later. 536 my $protocol_name; 537 538 # Unix sockets don't use protocols; warn the programmer, and force 539 # PF_UNSPEC. 540 if ($abstract_domain eq DOM_UNIX) { 541 carp 'SocketProtocol ignored for Unix socket' 542 if defined $params{SocketProtocol}; 543 $self->[MY_SOCKET_PROTOCOL] = PF_UNSPEC; 544 $protocol_name = 'none'; 545 } 546 547 # Internet sockets use protocols. Default the INET protocol to tcp, 548 # and try to resolve it. 549 elsif ( 550 $abstract_domain eq DOM_INET or 551 $abstract_domain eq DOM_INET6 552 ) { 553 my $socket_protocol = ( 554 (defined $params{SocketProtocol}) 555 ? $params{SocketProtocol} 556 : 'tcp' 557 ); 558 559 560 if ($socket_protocol !~ /^\d+$/) { 561 unless ($socket_protocol = $proto_by_name{$socket_protocol} || eval { getprotobyname($socket_protocol) }) { 562 $poe_kernel->yield( 563 $event_failure, 'getprotobyname', $!+0, $!, $self->[MY_UNIQUE_ID] 564 ); 565 return $self; 566 } 567 } 568 569 # Get the protocol's name regardless of what was provided. If the 570 # protocol isn't supported, croak now instead of making the 571 # programmer wonder why things fail later. 572 $protocol_name = $proto_by_number{$socket_protocol} || eval { lc(getprotobynumber($socket_protocol)) }; 573 unless ($protocol_name) { 574 $poe_kernel->yield( 575 $event_failure, 'getprotobynumber', $!+0, $!, $self->[MY_UNIQUE_ID] 576 ); 577 return $self; 578 } 579 580 unless (defined $supported_protocol{$abstract_domain}->{$protocol_name}) { 581 croak "SocketFactory does not support Internet $protocol_name sockets"; 582 } 583 584 $self->[MY_SOCKET_PROTOCOL] = $socket_protocol; 585 } 586 else { 587 die "Mail this error to the author of POE: Internal consistency error"; 588 } 589 590 # If no SocketType, default it to something appropriate. 591 if (defined $params{SocketType}) { 592 $self->[MY_SOCKET_TYPE] = $params{SocketType}; 593 } 594 else { 595 unless (defined $default_socket_type{$abstract_domain}->{$protocol_name}) { 596 croak "SocketFactory does not support $abstract_domain $protocol_name"; 597 } 598 $self->[MY_SOCKET_TYPE] = 599 $default_socket_type{$abstract_domain}->{$protocol_name}; 600 } 601 602 # o create a dummy socket 603 # o cache the value of SO_OPENTYPE in $win32_socket_opt 604 # o set the overlapped io attribute 605 # o close dummy socket 606 my $win32_socket_opt; 607 if ( POE::Kernel::RUNNING_IN_HELL) { 608 609 # Constants are evaluated first so they exist when the code uses 610 # them. 611 eval { 612 *SO_OPENTYPE = sub () { 0x7008 }; 613 *SO_SYNCHRONOUS_ALERT = sub () { 0x10 }; 614 *SO_SYNCHRONOUS_NONALERT = sub () { 0x20 }; 615 }; 616 die "Could not install SO constants [$@]" if $@; 617 618 # Turn on socket overlapped IO attribute per MSKB: Q181611. 619 620 eval { 621 socket(POE, AF_INET, SOCK_STREAM, IPPROTO_TCP) 622 or die "socket failed: $!"; 623 my $opt = unpack("I", getsockopt(POE, SOL_SOCKET, SO_OPENTYPE())); 624 $win32_socket_opt = $opt; 625 $opt &= ~(SO_SYNCHRONOUS_ALERT()|SO_SYNCHRONOUS_NONALERT()); 626 setsockopt(POE, SOL_SOCKET, SO_OPENTYPE(), $opt); 627 close POE; 628 }; 629 630 die if $@; 631 } 632 633 # Create the socket. 634 unless ( 635 socket( $socket_handle, $self->[MY_SOCKET_DOMAIN], 636 $self->[MY_SOCKET_TYPE], $self->[MY_SOCKET_PROTOCOL] 637 ) 638 ) { 639 $poe_kernel->yield( 640 $event_failure, 'socket', $!+0, $!, $self->[MY_UNIQUE_ID] 641 ); 642 return $self; 643 } 644 645 # o create a dummy socket 646 # o restore previous value of SO_OPENTYPE 647 # o close dummy socket 648 # 649 # This way we'd only be turning on the overlap attribute for 650 # the socket we created... and not all subsequent sockets. 651 if ( POE::Kernel::RUNNING_IN_HELL) { 652 eval { 653 socket(POE, AF_INET, SOCK_STREAM, IPPROTO_TCP) 654 or die "socket failed: $!"; 655 setsockopt(POE, SOL_SOCKET, SO_OPENTYPE(), $win32_socket_opt); 656 close POE; 657 }; 658 659 die if $@; 660 } 661 DEBUG && warn "socket"; 662 663 #------------------# 664 # Configure Socket # 665 #------------------# 666 667 # Make the socket binary. It's wrapped in eval{} because tied 668 # filehandle classes may actually die in their binmode methods. 669 eval { binmode($socket_handle) }; 670 671 # Don't block on socket operations, because the socket will be 672 # driven by a select loop. 673 $socket_handle->blocking(0); 674 675 # Make the socket reusable, if requested. 676 if ( 677 (defined $params{Reuse}) 678 and ( (lc($params{Reuse}) eq 'yes') 679 or (lc($params{Reuse}) eq 'on') 680 or ( ($params{Reuse} =~ /\d+/) 681 and $params{Reuse} 682 ) 683 ) 684 ) 685 { 686 setsockopt($socket_handle, SOL_SOCKET, SO_REUSEADDR, 1) or do { 687 $poe_kernel->yield( 688 $event_failure, 689 'setsockopt', $!+0, $!, $self->[MY_UNIQUE_ID] 690 ); 691 return $self; 692 }; 693 } 694 695 #-------------# 696 # Bind Socket # 697 #-------------# 698 699 my $bind_address; 700 701 # Check SocketFactory /Bind.*/ parameters in an Internet socket 702 # context, and translate them into parameters that bind() 703 # understands. 704 if ($abstract_domain eq DOM_INET) { 705 # Don't bind if the creator doesn't specify a related parameter. 706 if ((defined $params{BindAddress}) or (defined $params{BindPort})) { 707 708 # Set the bind address, or default to INADDR_ANY. 709 $bind_address = ( 710 (defined $params{BindAddress}) 711 ? $params{BindAddress} 712 : INADDR_ANY 713 ); 714 715 # Need to check lengths in octets, not characters. 716 BEGIN { eval { require bytes } and bytes->import; } 717 718 # Resolve the bind address if it's not already packed. 719 unless (length($bind_address) == 4) { 720 $bind_address = inet_aton($bind_address); 721 } 722 723 unless (defined $bind_address) { 724 $! = EADDRNOTAVAIL; 725 $poe_kernel->yield( 726 $event_failure, 727 "inet_aton", $!+0, $!, $self->[MY_UNIQUE_ID] 728 ); 729 return $self; 730 } 731 732 # Set the bind port, or default to 0 (any) if none specified. 733 # Resolve it to a number, if at all possible. 734 my $bind_port = (defined $params{BindPort}) ? $params{BindPort} : 0; 735 if ($bind_port =~ /[^0-9]/) { 736 $bind_port = getservbyname($bind_port, $protocol_name); 737 unless (defined $bind_port) { 738 $! = EADDRNOTAVAIL; 739 $poe_kernel->yield( 740 $event_failure, 741 'getservbyname', $!+0, $!, $self->[MY_UNIQUE_ID] 742 ); 743 return $self; 744 } 745 } 746 747 $bind_address = pack_sockaddr_in($bind_port, $bind_address); 748 unless (defined $bind_address) { 749 $poe_kernel->yield( 750 $event_failure, 751 "pack_sockaddr_in", $!+0, $!, $self->[MY_UNIQUE_ID] 752 ); 753 return $self; 754 } 755 } 756 } 757 758 # Check SocketFactory /Bind.*/ parameters in an Internet socket 759 # context, and translate them into parameters that bind() 760 # understands. 761 elsif ($abstract_domain eq DOM_INET6) { 762 763 # Don't bind if the creator doesn't specify a related parameter. 764 if ((defined $params{BindAddress}) or (defined $params{BindPort})) { 765 766 # Set the bind address, or default to INADDR_ANY. 767 $bind_address = ( 768 (defined $params{BindAddress}) 769 ? $params{BindAddress} 770 : "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" # XXX - Only Socket6 has? 771 ); 772 773 # Set the bind port, or default to 0 (any) if none specified. 774 # Resolve it to a number, if at all possible. 775 my $bind_port = (defined $params{BindPort}) ? $params{BindPort} : 0; 776 if ($bind_port =~ /[^0-9]/) { 777 $bind_port = getservbyname($bind_port, $protocol_name); 778 unless (defined $bind_port) { 779 $! = EADDRNOTAVAIL; 780 $poe_kernel->yield( 781 $event_failure, 782 'getservbyname', $!+0, $!, $self->[MY_UNIQUE_ID] 783 ); 784 return $self; 785 } 786 } 787 788 # Need to check lengths in octets, not characters. 789 BEGIN { eval { require bytes } and bytes->import; } 790 791 # Undef $bind_address if IN6ADDR_ANY and handle with AI_PASSIVE 792 if ( $bind_address eq '::' || $bind_address eq "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" ) { 793 $bind_address = undef; 794 } 795 796 # Resolve the bind address. 797 my ($error, @addresses) = getaddrinfo( 798 $bind_address, $bind_port, { 799 family => $self->[MY_SOCKET_DOMAIN], 800 socktype => $self->[MY_SOCKET_TYPE], 801 ( defined $bind_address ? () : ( flags => 1 ) ), 802 } 803 ); 804 805 unless (@addresses) { 806 warn $error if $error; 807 808 $! = EADDRNOTAVAIL; 809 $poe_kernel->yield( 810 $event_failure, 811 "getaddrinfo", $!+0, $!, $self->[MY_UNIQUE_ID] 812 ); 813 return $self; 814 } 815 816 $bind_address = $addresses[0]->{addr}; 817 } 818 } 819 820 # Check SocketFactory /Bind.*/ parameters in a Unix context, and 821 # translate them into parameters bind() understands. 822 elsif ($abstract_domain eq DOM_UNIX) { 823 carp 'BindPort ignored for Unix socket' if defined $params{BindPort}; 824 825 if (defined $params{BindAddress}) { 826 # Is this necessary, or will bind() return EADDRINUSE? 827 if (defined $params{RemotePort}) { 828 $! = EADDRINUSE; 829 $poe_kernel->yield( 830 $event_failure, 831 'bind', $!+0, $!, $self->[MY_UNIQUE_ID] 832 ); 833 return $self; 834 } 835 836 $bind_address = &_condition_unix_address($params{BindAddress}); 837 $bind_address = pack_sockaddr_un($bind_address); 838 unless ($bind_address) { 839 $poe_kernel->yield( 840 $event_failure, 841 'pack_sockaddr_un', $!+0, $!, $self->[MY_UNIQUE_ID] 842 ); 843 return $self; 844 } 845 } 846 } 847 848 # This is an internal consistency error, and it should be hard 849 # trapped right away. 850 else { 851 die "Mail this error to the author of POE: Internal consistency error"; 852 } 853 854 # Perform the actual bind, if there's a bind address to bind to. 855 if (defined $bind_address) { 856 unless (bind($socket_handle, $bind_address)) { 857 $poe_kernel->yield( 858 $event_failure, 859 'bind', $!+0, $!, $self->[MY_UNIQUE_ID] 860 ); 861 return $self; 862 } 863 864 DEBUG && warn "bind"; 865 } 866 867 #---------# 868 # Connect # 869 #---------# 870 871 my $connect_address; 872 873 if (defined $params{RemoteAddress}) { 874 875 # Check SocketFactory /Remote.*/ parameters in an Internet socket 876 # context, and translate them into parameters that connect() 877 # understands. 878 if ( 879 $abstract_domain eq DOM_INET or 880 $abstract_domain eq DOM_INET6 881 ) { 882 # connecting if RemoteAddress 883 croak 'RemotePort required' unless (defined $params{RemotePort}); 884 carp 'ListenQueue ignored' if (defined $params{ListenQueue}); 885 886 my $remote_port = $params{RemotePort}; 887 if ($remote_port =~ /[^0-9]/) { 888 unless ($remote_port = getservbyname($remote_port, $protocol_name)) { 889 $! = EADDRNOTAVAIL; 890 $poe_kernel->yield( 891 $event_failure, 892 'getservbyname', $!+0, $!, $self->[MY_UNIQUE_ID] 893 ); 894 return $self; 895 } 896 } 897 898 my $error_tag; 899 if ($abstract_domain eq DOM_INET) { 900 $connect_address = inet_aton($params{RemoteAddress}); 901 $error_tag = "inet_aton"; 902 } 903 elsif ($abstract_domain eq DOM_INET6) { 904 my ($error, @addresses) = getaddrinfo( 905 $params{RemoteAddress}, $remote_port, { 906 family => $self->[MY_SOCKET_DOMAIN], 907 socktype => $self->[MY_SOCKET_TYPE], 908 }, 909 ); 910 911 unless (@addresses) { 912 warn $error if $error; 913 $connect_address = undef; 914 } 915 else { 916 $connect_address = $addresses[0]->{addr}; 917 } 918 919 $error_tag = "getaddrinfo"; 920 } 921 else { 922 die "unknown domain $abstract_domain"; 923 } 924 925 # TODO - If the gethostbyname2() code is removed, then we can 926 # combine the previous code with the following code, and perhaps 927 # remove one of these redundant $connect_address checks. The 928 # 0.29 release should tell us pretty quickly whether it's 929 # needed. If we reach 0.30 without incident, it's probably safe 930 # to remove the old gethostbyname2() code and clean this up. 931 unless (defined $connect_address) { 932 $! = EADDRNOTAVAIL; 933 $poe_kernel->yield( 934 $event_failure, 935 $error_tag, $!+0, $!, $self->[MY_UNIQUE_ID] 936 ); 937 return $self; 938 } 939 940 if ($abstract_domain eq DOM_INET) { 941 $connect_address = pack_sockaddr_in($remote_port, $connect_address); 942 $error_tag = "pack_sockaddr_in"; 943 } 944 elsif ($abstract_domain eq DOM_INET6) { 945 $error_tag = "pack_sockaddr_in6"; 946 } 947 else { 948 die "unknown domain $abstract_domain"; 949 } 950 951 unless ($connect_address) { 952 $! = EADDRNOTAVAIL; 953 $poe_kernel->yield( 954 $event_failure, 955 $error_tag, $!+0, $!, $self->[MY_UNIQUE_ID] 956 ); 957 return $self; 958 } 959 } 960 961 # Check SocketFactory /Remote.*/ parameters in a Unix socket 962 # context, and translate them into parameters connect() 963 # understands. 964 elsif ($abstract_domain eq DOM_UNIX) { 965 966 $connect_address = _condition_unix_address($params{RemoteAddress}); 967 $connect_address = pack_sockaddr_un($connect_address); 968 unless (defined $connect_address) { 969 $poe_kernel->yield( 970 $event_failure, 971 'pack_sockaddr_un', $!+0, $!, $self->[MY_UNIQUE_ID] 972 ); 973 return $self; 974 } 975 } 976 977 # This is an internal consistency error, and it should be trapped 978 # right away. 979 else { 980 die "Mail this error to the author of POE: Internal consistency error"; 981 } 982 } 983 984 else { 985 carp "RemotePort ignored without RemoteAddress" 986 if defined $params{RemotePort}; 987 } 988 989 # Perform the actual connection, if a connection was requested. If 990 # the connection can be established, then return the SocketFactory 991 # handle. 992 if (defined $connect_address) { 993 unless (connect($socket_handle, $connect_address)) { 994 if ($! and ($! != EINPROGRESS) and ($! != EWOULDBLOCK)) { 995 $poe_kernel->yield( 996 $event_failure, 997 'connect', $!+0, $!, $self->[MY_UNIQUE_ID] 998 ); 999 return $self; 1000 } 1001 } 1002 1003 DEBUG && warn "connect"; 1004 1005 $self->[MY_SOCKET_HANDLE] = $socket_handle; 1006 $self->_define_connect_state(); 1007 $self->event( 1008 SuccessEvent => $params{SuccessEvent}, 1009 FailureEvent => $params{FailureEvent}, 1010 ); 1011 return $self; 1012 } 1013 1014 #---------------------# 1015 # Listen, or Whatever # 1016 #---------------------# 1017 1018 # A connection wasn't requested, so this must be a server socket. 1019 # Do whatever it is that needs to be done for whatever type of 1020 # server socket this is. 1021 if (exists $supported_protocol{$abstract_domain}->{$protocol_name}) { 1022 my $protocol_op = $supported_protocol{$abstract_domain}->{$protocol_name}; 1023 1024 DEBUG && warn "$abstract_domain + $protocol_name = $protocol_op"; 1025 1026 if ($protocol_op eq SVROP_LISTENS) { 1027 my $listen_queue = $params{ListenQueue} || SOMAXCONN; 1028 # <rmah> In SocketFactory, you limit the ListenQueue parameter 1029 # to SOMAXCON (or is it SOCONNMAX?)...why? 1030 # <rmah> ah, here's czth, he'll have more to say on this issue 1031 # <czth> not really. just that SOMAXCONN can lie, notably on 1032 # Solaris and reportedly on BSDs too 1033 # 1034 # ($listen_queue > SOMAXCONN) && ($listen_queue = SOMAXCONN); 1035 unless (listen($socket_handle, $listen_queue)) { 1036 $poe_kernel->yield( 1037 $event_failure, 1038 'listen', $!+0, $!, $self->[MY_UNIQUE_ID] 1039 ); 1040 return $self; 1041 } 1042 1043 DEBUG && warn "listen"; 1044 1045 $self->[MY_SOCKET_HANDLE] = $socket_handle; 1046 $self->_define_accept_state(); 1047 $self->event( 1048 SuccessEvent => $params{SuccessEvent}, 1049 FailureEvent => $params{FailureEvent}, 1050 ); 1051 return $self; 1052 } 1053 else { 1054 carp "Ignoring ListenQueue parameter for non-listening socket" 1055 if defined $params{ListenQueue}; 1056 if ($protocol_op eq SVROP_NOTHING) { 1057 # Do nothing. Duh. Fire off a success event immediately, and 1058 # return. 1059 $poe_kernel->yield( 1060 $event_success, 1061 $socket_handle, undef, undef, $self->[MY_UNIQUE_ID] 1062 ); 1063 return $self; 1064 } 1065 else { 1066 die "Mail this error to the author of POE: Internal consistency error"; 1067 } 1068 } 1069 } 1070 else { 1071 die "SocketFactory doesn't support $abstract_domain $protocol_name socket"; 1072 } 1073 1074 die "Mail this error to the author of POE: Internal consistency error"; 1075} 1076 1077# Pause and resume accept. 1078sub pause_accept { 1079 my $self = shift; 1080 if ( 1081 defined $self->[MY_SOCKET_HANDLE] and 1082 defined $self->[MY_STATE_ACCEPT] and 1083 defined $self->[MY_SOCKET_SELECTED] 1084 ) { 1085 $poe_kernel->select_pause_read($self->[MY_SOCKET_HANDLE]); 1086 } 1087} 1088 1089sub resume_accept { 1090 my $self = shift; 1091 if ( 1092 defined $self->[MY_SOCKET_HANDLE] and 1093 defined $self->[MY_STATE_ACCEPT] and 1094 defined $self->[MY_SOCKET_SELECTED] 1095 ) { 1096 $poe_kernel->select_resume_read($self->[MY_SOCKET_HANDLE]); 1097 } 1098} 1099 1100#------------------------------------------------------------------------------ 1101# DESTROY and _shutdown pass things by reference because _shutdown is 1102# called from the state() closures above. As a result, we can't 1103# mention $self explicitly, or the wheel won't shut itself down 1104# properly. Rather, it will form a circular reference on $self. 1105 1106sub DESTROY { 1107 my $self = shift; 1108 _shutdown( 1109 \$self->[MY_SOCKET_SELECTED], 1110 \$self->[MY_SOCKET_HANDLE], 1111 \$self->[MY_STATE_ACCEPT], 1112 \$self->[MY_STATE_CONNECT], 1113 \$self->[MY_MINE_SUCCESS], 1114 \$self->[MY_EVENT_SUCCESS], 1115 \$self->[MY_MINE_FAILURE], 1116 \$self->[MY_EVENT_FAILURE], 1117 ); 1118 &POE::Wheel::free_wheel_id($self->[MY_UNIQUE_ID]); 1119} 1120 1121sub _shutdown { 1122 my ( 1123 $socket_selected, $socket_handle, 1124 $state_accept, $state_connect, 1125 $mine_success, $event_success, 1126 $mine_failure, $event_failure, 1127 ) = @_; 1128 1129 if (defined $$socket_selected) { 1130 $poe_kernel->select($$socket_handle); 1131 $$socket_selected = undef; 1132 } 1133 1134 if (defined $$state_accept) { 1135 $poe_kernel->state($$state_accept); 1136 $$state_accept = undef; 1137 } 1138 1139 if (defined $$state_connect) { 1140 $poe_kernel->state($$state_connect); 1141 $$state_connect = undef; 1142 } 1143 1144 if (defined $$mine_success) { 1145 $poe_kernel->state($$event_success); 1146 $$mine_success = $$event_success = undef; 1147 } 1148 1149 if (defined $$mine_failure) { 1150 $poe_kernel->state($$event_failure); 1151 $$mine_failure = $$event_failure = undef; 1152 } 1153} 1154 11551; 1156 1157__END__ 1158 1159=head1 NAME 1160 1161POE::Wheel::SocketFactory - non-blocking socket creation 1162 1163=head1 SYNOPSIS 1164 1165See L<POE::Component::Server::TCP/SYNOPSIS> for a much simpler version 1166of this program. 1167 1168 #!perl 1169 1170 use warnings; 1171 use strict; 1172 1173 use IO::Socket; 1174 use POE qw(Wheel::SocketFactory Wheel::ReadWrite); 1175 1176 POE::Session->create( 1177 inline_states => { 1178 _start => sub { 1179 # Start the server. 1180 $_[HEAP]{server} = POE::Wheel::SocketFactory->new( 1181 BindPort => 12345, 1182 SuccessEvent => "on_client_accept", 1183 FailureEvent => "on_server_error", 1184 ); 1185 }, 1186 on_client_accept => sub { 1187 # Begin interacting with the client. 1188 my $client_socket = $_[ARG0]; 1189 my $io_wheel = POE::Wheel::ReadWrite->new( 1190 Handle => $client_socket, 1191 InputEvent => "on_client_input", 1192 ErrorEvent => "on_client_error", 1193 ); 1194 $_[HEAP]{client}{ $io_wheel->ID() } = $io_wheel; 1195 }, 1196 on_server_error => sub { 1197 # Shut down server. 1198 my ($operation, $errnum, $errstr) = @_[ARG0, ARG1, ARG2]; 1199 warn "Server $operation error $errnum: $errstr\n"; 1200 delete $_[HEAP]{server}; 1201 }, 1202 on_client_input => sub { 1203 # Handle client input. 1204 my ($input, $wheel_id) = @_[ARG0, ARG1]; 1205 $input =~ tr[a-zA-Z][n-za-mN-ZA-M]; # ASCII rot13 1206 $_[HEAP]{client}{$wheel_id}->put($input); 1207 }, 1208 on_client_error => sub { 1209 # Handle client error, including disconnect. 1210 my $wheel_id = $_[ARG3]; 1211 delete $_[HEAP]{client}{$wheel_id}; 1212 }, 1213 } 1214 ); 1215 1216 POE::Kernel->run(); 1217 exit; 1218 1219=head1 DESCRIPTION 1220 1221POE::Wheel::SocketFactory creates sockets upon demand. It can create 1222connectionless UDP sockets, but it really shines for client/server 1223work where establishing connections normally would block. 1224 1225=head1 PUBLIC METHODS 1226 1227=head2 new 1228 1229new() creates a new POE::Wheel::SocketFactory object. For sockets 1230which listen() for and accept() connections, the wheel will generate 1231new sockets for each accepted client. Socket factories for one-shot 1232sockets, such as UDP peers or clients established by connect() only 1233emit a single socket and can be destroyed afterwards without ill 1234effects. 1235 1236new() always returns a POE::Wheel::SocketFactory object even if it 1237fails to establish the socket. This allows the object to be queried 1238after it has sent its session a C<FailureEvent>. 1239 1240new() accepts a healthy number of named parameters, each governing 1241some aspect of socket creation. 1242 1243=head3 Creating the Socket 1244 1245Socket creation is done with Perl's built-in socket() function. The 1246new() parameters beginning with C<Socket> determine how socket() will 1247be called. 1248 1249=head4 SocketDomain 1250 1251C<SocketDomain> instructs the wheel to create a socket within a 1252particular domain. Supported domains are C<AF_UNIX>, C<AF_INET>, 1253C<AF_INET6>, C<PF_UNIX>, C<PF_INET>, and C<PF_INET6>. If omitted, the 1254socket will be created in the C<AF_INET> domain. 1255 1256POE::Wheel::SocketFactory contains a table of supported domains and 1257the instructions needed to create them. Please send patches to 1258support additional domains, as needed. 1259 1260Note: C<AF_INET6> and C<PF_INET6> are supplied by the L<Socket> 1261module included in Perl 5.8.0 or later. Perl versions before 5.8.0 1262should not attempt to use IPv6 until someone contributes a workaround. 1263 1264IPv6 support requires a Socket module that implements getaddrinfo() 1265and unpack_sockaddr_in6(). There may be other modules that perform 1266these functions, but most if not all of them have been deprecated with 1267the advent of proper core Socket support for IPv6. 1268 1269=for comment 1270TODO - Example. 1271 1272=head4 SocketType 1273 1274C<SocketType> supplies the socket() call with a particular socket 1275type, which may be C<SOCK_STREAM> or C<SOCK_DGRAM>. C<SOCK_STREAM> is 1276the default if C<SocketType> is not supplied. 1277 1278=for comment 1279TODO - Example. 1280 1281=head4 SocketProtocol 1282 1283C<SocketProtocol> sets the socket() call's protocol. Protocols may be 1284specified by number or name. C<SocketProtocol> is ignored for UNIX 1285domain sockets. 1286 1287The protocol defaults to "tcp" for INET domain sockets. There is no 1288default for other socket domains. 1289 1290=for comment 1291TODO - Example. 1292 1293=head3 Setting Socket Options 1294 1295POE::Wheel::SocketFactory uses ioctl(), fcntl() and setsockopt() to 1296set socket options after the socket is created. All sockets are set 1297non-blocking, and bound sockets may be made reusable. 1298 1299=head4 Reuse 1300 1301When set, the C<Reuse> parameter allows a bound port to be reused 1302immediately. C<Reuse> is considered enabled if it contains "yes", 1303"on", or a true numeric value. All other values disable port reuse, 1304as does omitting C<Reuse> entirely. 1305 1306For security purposes, a port cannot be reused for a minute or more 1307after a server has released it. This gives clients time to realize 1308the port has been abandoned. Otherwise a malicious service may snatch 1309up the port and spoof the legitimate service. 1310 1311It's also terribly annoying to wait a minute or more between server 1312invocations, especially during development. 1313 1314=head3 Bind the Socket to an Address and Port 1315 1316A socket may optionally be bound to a specific interface and port. 1317The C<INADDR_ANY> address may be used to bind to a specific port 1318across all interfaces. 1319 1320Sockets are bound using bind(). POE::Wheel::SocketFactory parameters 1321beginning with C<Bind> control how bind() is called. 1322 1323=head4 BindAddress 1324 1325C<BindAddress> sets an address to bind the socket's local endpoint to. 1326C<INADDR_ANY> will be used if C<BindAddress> is not specified. 1327 1328C<BindAddress> may contain either a string or a packed Internet 1329address (for "INET" domain sockets). The string parameter should be a 1330dotted numeric address or a resolvable host name. Note that the host 1331name will be resolved with a blocking call. If this is not desired, 1332use POE::Component::Client::DNS to perform a non-blocking name 1333resolution. 1334 1335When used to bind a "UNIX" domain socket, C<BindAddress> should 1336contain a path describing the socket's filename. This is required for 1337server sockets and datagram client sockets. C<BindAddress> has no 1338default value for UNIX sockets. 1339 1340=for comment 1341TODO - Example. 1342 1343=head4 BindPort 1344 1345C<BindPort> is only meaningful for "INET" domain sockets. It contains 1346a port on the C<BindAddress> interface where the socket will be bound. 1347It defaults to 0 if omitted, which will cause the bind() call to 1348choose an indeterminate unallocated port. 1349 1350C<BindPort> may be a port number or a name that can be looked up in 1351the system's services (or equivalent) database. 1352 1353=for comment 1354TODO - Example. 1355 1356=head3 Connectionless Sockets 1357 1358Connectionless sockets may interact with remote endpoints without 1359needing to listen() for connections or connect() to remote addresses. 1360 1361This class of sockets is complete after the bind() call. 1362 1363=for comment 1364TODO - Example. 1365 1366=head3 Connecting the Socket to a Remote Endpoint 1367 1368A socket may either listen for connections to arrive, initiate 1369connections to a remote endpoint, or be connectionless (such as in the 1370case of UDP sockets). 1371 1372POE::Wheel::SocketFactory will initiate a client connection when new() 1373is capped with parameters that describe a remote endpoint. In all 1374other cases, the socket will either listen for connections or be 1375connectionless depending on the socket type. 1376 1377The following parameters describe a socket's remote endpoint. They 1378determine how POE::Wheel::SocketFactory will call Perl's built-in 1379connect() function. 1380 1381=head4 RemoteAddress 1382 1383C<RemoteAddress> specifies the remote address to which a socket should 1384connect. If present, POE::Wheel::SocketFactory will create a client 1385socket that attempts to collect to the C<RemoteAddress>. Otherwise, 1386if the protocol warrants it, the wheel will create a listening socket 1387and attempt to accept connections. 1388 1389As with the bind address, C<RemoteAddress> may be a string containing 1390a dotted quad or a resolvable host name. It may also be a packed 1391Internet address, or a UNIX socket path. It will be packed, with or 1392without an accompanying C<RemotePort>, as necessary for the socket 1393domain. 1394 1395=for comment 1396TODO - Example. 1397 1398=head4 RemotePort 1399 1400C<RemotePort> is the port to which the socket should connect. It is 1401required for "INET" client sockets, since the remote endpoint must 1402contain both an address and a port. 1403 1404The remote port may be numeric, or it may be a symbolic name found in 1405/etc/services or the equivalent for your operating system. 1406 1407=for comment 1408TODO - Example. 1409 1410=head3 Listening for Connections 1411 1412Streaming sockets that have no remote endpoint are considered to be 1413server sockets. POE::Wheel::SocketFactory will listen() for 1414connections to these sockets, accept() the new clients, and send the 1415application events with the new client sockets. 1416 1417POE::Wheel::SocketFactory constructor parameters beginning with 1418C<Listen> control how the listen() function is called. 1419 1420=head4 ListenQueue 1421 1422C<ListenQueue> specifies the length of the socket's listen() queue. 1423It defaults to C<SOMAXCONN> if omitted. C<ListenQueue> values greater 1424than C<SOMAXCONN> will be clipped to C<SOMAXCONN>. Excessively large 1425C<ListenQueue> values are not necessarily portable, and may cause 1426errors in some rare cases. 1427 1428=for comment 1429TODO - Example. 1430 1431=head3 Emitting Events 1432 1433POE::Wheel::SocketFactory emits a small number of events depending on 1434what happens during socket setup or while listening for new 1435connections. 1436 1437See L</PUBLIC EVENTS> for more details. 1438 1439=head4 SuccessEvent 1440 1441C<SuccessEvent> names the event that will be emitted whenever 1442POE::Wheel::SocketFactory succeeds in creating a new socket. 1443 1444For connectionless sockets, C<SuccessEvent> happens just after the 1445socket is created. 1446 1447For client connections, C<SuccessEvent> is fired when the connection 1448has successfully been established with the remote endpoint. 1449 1450Server sockets emit a C<SuccessEvent> for every successfully accepted 1451client. 1452 1453=head4 FailureEvent 1454 1455C<FailureEvent> names the event POE::Wheel::SocketFactory will emit 1456whenever something goes wrong. It usually represents some kind of 1457built-in function call error. See L</PUBLIC EVENTS> for details, as 1458some errors are handled internally by this wheel. 1459 1460=head2 event 1461 1462event() allows a session to change the events emitted by a wheel 1463without destroying and re-creating the wheel. It accepts one or more 1464of the events listed in L</PUBLIC EVENTS>. Undefined event names 1465disable those events. 1466 1467event() is described in more depth in L<POE::Wheel>. 1468 1469=for comment 1470TODO - Example. 1471 1472=head2 getsockname 1473 1474getsockname() behaves like the built-in function of the same name. It 1475returns the local endpoint information for POE::Wheel::SocketFactory's 1476encapsulated listening socket. 1477 1478getsockname() allows applications to determine the address and port 1479to which POE::Wheel::SocketFactory has bound its listening socket. 1480 1481Test applications may use getsockname() to find the server socket 1482after POE::Wheel::SocketFactory has bound to INADDR_ANY port 0. 1483 1484Since there is no event fired immediately after a successful creation of a 1485listening socket, applications can use getsockname() to verify this. 1486 1487 use Socket 'unpack_sockaddr_in'; 1488 1489 my $listener = POE::Wheel::SocketFactory->new( 1490 BindPort => 123, 1491 SuccessEvent => 'got_client', 1492 FailureEvent => 'listener_failed', 1493 Reuse => 'on', 1494 ); 1495 1496 my ($port, $addr) = unpack_sockaddr_in($listener->getsockname); 1497 print "Socket successfully bound\n" if $port; 1498 1499=head2 ID 1500 1501ID() returns the wheel's unique ID. The ID will also be included in 1502every event the wheel generates. Applications can match events back 1503to the objects that generated them. 1504 1505=for comment 1506TODO - Example. 1507 1508=head2 pause_accept 1509 1510Applications may occasionally need to block incoming connections. 1511pause_accept() pauses the event watcher that triggers accept(). New 1512inbound connections will stack up in the socket's listen() queue until 1513the queue overflows or the application calls resume_accept(). 1514 1515Pausing accept() can limit the amount of load a server generates. 1516It's also useful in pre-forking servers when the master process 1517shouldn't accept connections at all. 1518 1519pause_accept() and resume_accept() is quicker and more reliable than 1520dynamically destroying and re-creating a POE::Wheel::SocketFactory 1521object. 1522 1523=for comment 1524TODO - Example. 1525 1526=head2 resume_accept 1527 1528resume_accept() resumes the watcher that triggers accept(). See 1529L</pause_accept> for a more detailed discussion. 1530 1531=head1 PUBLIC EVENTS 1532 1533POE::Wheel::SocketFactory emits two public events. 1534 1535=head2 SuccessEvent 1536 1537C<SuccessEvent> names an event that will be sent to the creating 1538session whenever a POE::Wheel::SocketFactory has created a new socket. 1539For connectionless sockets, it's when the socket is created. For 1540connecting clients, it's after the connection has been established. 1541And for listening servers, C<SuccessEvent> is fired after each new 1542client is accepted. 1543 1544=head3 Common SuccessEvent Parameters 1545 1546In all cases, C<$_[ARG0]> holds the new socket's filehandle, and 1547C<$_[ARG3]> contains the POE::Wheel::SocketFactory's ID. Other 1548parameters vary depending on the socket's domain and whether it's 1549listening or connecting. See below for the differences. 1550 1551=head3 INET SuccessEvent Parameters 1552 1553For INET sockets, C<$_[ARG1]> and C<$_[ARG2]> hold the socket's remote 1554address and port, respectively. The address is packed; see 1555L<Socket/inet_ntop> if a human-readable address is needed. 1556 1557 sub handle_new_client { 1558 my $accepted_socket = $_[ARG0]; 1559 1560 my $peer_host = inet_ntop( 1561 ((length($_[ARG1]) == 4) ? AF_INET : AF_INET6), 1562 $_[ARG1] 1563 ); 1564 1565 print( 1566 "Wheel $_[ARG3] accepted a connection from ", 1567 "$peer_host port $peer_port\n" 1568 ); 1569 1570 spawn_connection_session($accepted_handle); 1571 } 1572 1573=head3 UNIX Client SuccessEvent Parameters 1574 1575For UNIX client sockets, C<$_[ARG1]> often (but not always) holds the 1576server address. Some systems cannot retrieve a UNIX socket's remote 1577address. C<$_[ARG2]> is always undef for UNIX client sockets. 1578 1579=head3 UNIX Server SuccessEvent Parameters 1580 1581According to I<Perl Cookbook>, the remote address returned by accept() 1582on UNIX sockets is undefined, so C<$_[ARG1]> and C<$_[ARG2]> are also 1583undefined in this case. 1584 1585=head2 FailureEvent 1586 1587C<FailureEvent> names the event that will be emitted when a socket 1588error occurs. POE::Wheel::SocketFactory handles C<EAGAIN> internally, 1589so it doesn't count as an error. 1590 1591C<FailureEvent> events include the standard error event parameters: 1592 1593C<$_[ARG0]> describes which part of socket creation failed. It often 1594holds a Perl built-in function name. 1595 1596C<$_[ARG1]> and C<$_[ARG2]> describe how the operation failed. They 1597contain the numeric and stringified versions of C<$!>, respectively. 1598An application cannot merely check the global C<$!> variable since it 1599may change during event dispatch. 1600 1601Finally, C<$_[ARG3]> contains the ID for the POE::Wheel::SocketFactory 1602instance that generated the event. See L</ID> and L<POE::Wheel/ID> 1603for uses for wheel IDs. 1604 1605A sample FailureEvent handler: 1606 1607 sub handle_failure { 1608 my ($operation, $errnum, $errstr, $wheel_id) = @_[ARG0..ARG3]; 1609 warn "Wheel $wheel_id generated $operation error $errnum: $errstr\n"; 1610 delete $_[HEAP]{wheels}{$wheel_id}; # shut down that wheel 1611 } 1612 1613=head1 SEE ALSO 1614 1615L<POE::Wheel> describes the basic operations of all wheels in more 1616depth. You need to know this. 1617 1618L<Socket::GetAddrInfo> is required for IPv6 work. 1619POE::Wheel::SocketFactory will load it automatically if it's 1620installed. SocketDomain => AF_INET6 is required to trigger IPv6 1621behaviors. AF_INET6 is exported by the Socket module on all but the 1622oldest versions of Perl 5. If your Socket doesn't provide AF_INET6, 1623try installing Socket6 instead. 1624 1625The SEE ALSO section in L<POE> contains a table of contents covering 1626the entire POE distribution. 1627 1628=head1 BUGS 1629 1630Many (if not all) of the croak/carp/warn/die statements should fire 1631back C<FailureEvent> instead. 1632 1633SocketFactory is only tested with UNIX streams and INET sockets using 1634the UDP and TCP protocols. Others should work after the module's 1635internal configuration tables are updated. Please send patches. 1636 1637=head1 AUTHORS & COPYRIGHTS 1638 1639Please see L<POE> for more information about authors and contributors. 1640 1641=cut 1642 1643# rocco // vim: ts=2 sw=2 expandtab 1644# TODO - Edit. 1645