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