Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Added initial IPv6 support.

  • Loading branch information...
commit 64c395ffdd3e9f4b587dcb2e3d8e37ed6718b62a 1 parent 02f8bfd
Rocco Caputo authored
1  MANIFEST
@@ -114,3 +114,4 @@ t/25_detach.t
114 114 t/26_comp_tcp.t
115 115 t/27_poll.t
116 116 t/28_windows.t
  117 +t/29_sockfact6.t
15 lib/POE/Component/Client/TCP.pm
@@ -42,6 +42,7 @@ sub new {
42 42 my $alias = delete $param{Alias};
43 43 my $address = delete $param{RemoteAddress};
44 44 my $port = delete $param{RemotePort};
  45 + my $domain = delete $param{Domain};
45 46
46 47 foreach ( qw( Connected ConnectError Disconnected ServerInput
47 48 ServerError ServerFlushed
@@ -127,6 +128,7 @@ sub new {
127 128 $heap->{server} = POE::Wheel::SocketFactory->new
128 129 ( RemoteAddress => $address,
129 130 RemotePort => $port,
  131 + SocketDomain => $domain,
130 132 SuccessEvent => 'got_connect_success',
131 133 FailureEvent => 'got_connect_error',
132 134 );
@@ -244,6 +246,7 @@ POE::Component::Client::TCP - a simplified TCP client
244 246 POE::Component::Client::TCP->new
245 247 ( RemoteAddress => "127.0.0.1",
246 248 RemotePort => "chargen",
  249 + Domain => AF_INET, # Optional.
247 250 ServerInput => sub {
248 251 my $input = $_[ARG0];
249 252 print "from server: $input\n";
@@ -255,6 +258,7 @@ POE::Component::Client::TCP - a simplified TCP client
255 258 POE::Component::Client::TCP->new
256 259 ( RemoteAddress => "127.0.0.1",
257 260 RemotePort => "chargen",
  261 + Domain => AF_INET, # Optional.
258 262
259 263 Connected => \&handle_connect,
260 264 ConnectError => \&handle_connect_error,
@@ -383,6 +387,17 @@ example, this reconnects after waiting a minute:
383 387 The component will shut down after disconnecting if a reconnect isn't
384 388 requested.
385 389
  390 +=item Domain
  391 +
  392 +Specifies the domain within which communication will take place. It
  393 +selects the protocol family which should be used. Currently supported
  394 +values are AF_INET, AF_INET6, PF_INET or PF_INET6. This parameter is
  395 +optional and will default to AF_INET if omitted.
  396 +
  397 +Note: AF_INET6 and PF_INET6 are supplied by the Socket6 module, which
  398 +is available on the CPAN. You must have Socket6 loaded before
  399 +POE::Component::Server::TCP will create IPv6 sockets.
  400 +
386 401 =item Filter
387 402
388 403 Filter specifies the type of filter that will parse input from a
35 lib/POE/Component/Server/TCP.pm
@@ -40,6 +40,7 @@ sub new {
40 40 my $alias = delete $param{Alias};
41 41 my $address = delete $param{Address};
42 42 my $port = delete $param{Port};
  43 + my $domain = delete $param{Domain};
43 44
44 45 foreach ( qw( Acceptor Error ClientInput ClientConnected
45 46 ClientDisconnected ClientError ClientFlushed
@@ -124,7 +125,15 @@ sub new {
124 125 my ( $kernel, $session, $heap ) = @_[KERNEL, SESSION, HEAP];
125 126
126 127 $heap->{shutdown} = 0;
127   - $heap->{remote_ip} = inet_ntoa($remote_addr);
  128 +
  129 + if (length($remote_addr) == 4) {
  130 + $heap->{remote_ip} = inet_ntoa($remote_addr);
  131 + }
  132 + else {
  133 + $heap->{remote_ip} =
  134 + Socket6::inet_ntop($domain, $remote_addr);
  135 + }
  136 +
128 137 $heap->{remote_port} = $remote_port;
129 138
130 139 $heap->{client} = POE::Wheel::ReadWrite->new
@@ -203,6 +212,7 @@ sub new {
203 212 $_[HEAP]->{listener} = POE::Wheel::SocketFactory->new
204 213 ( BindPort => $port,
205 214 BindAddress => $address,
  215 + SocketDomain => $domain,
206 216 Reuse => 'yes',
207 217 SuccessEvent => 'tcp_server_got_connection',
208 218 FailureEvent => 'tcp_server_got_error',
@@ -271,6 +281,7 @@ POE::Component::Server::TCP - a simplified TCP server
271 281 POE::Component::Server::TCP->new
272 282 ( Port => $bind_port,
273 283 Address => $bind_address, # Optional.
  284 + Domain => AF_INET, # Optional.
274 285 Acceptor => \&accept_handler,
275 286 Error => \&error_handler, # Optional.
276 287 );
@@ -280,6 +291,7 @@ POE::Component::Server::TCP - a simplified TCP server
280 291 POE::Component::Server::TCP->new
281 292 ( Port => $bind_port,
282 293 Address => $bind_address, # Optional.
  294 + Domain => AF_INET, # Optional.
283 295 Acceptor => \&accept_handler, # Optional.
284 296 Error => \&error_handler, # Optional.
285 297
@@ -374,14 +386,16 @@ It disables the code that provides the /Client.*/ callbacks.
374 386 =item Address
375 387
376 388 Address is the optional interface address the TCP server will bind to.
377   -It defaults to INADDR_ANY.
  389 +It defaults to INADDR_ANY or INADDR6_ANY when using IPv4 or IPv6,
  390 +respectively.
378 391
379   - Address => '127.0.0.1'
  392 + Address => '127.0.0.1' # Localhost IPv4
  393 + Address => "::1" # Localhost IPv6
380 394
381 395 It's passed directly to SocketFactory's BindAddress parameter, so it
382 396 can be in whatever form SocketFactory supports. At the time of this
383   -writing, that's a dotted quad, a host name, or a packed Internet
384   -address.
  397 +writing, that's a dotted quad, an IPv6 address, a host name, or a
  398 +packed Internet address.
385 399
386 400 =item Alias
387 401
@@ -442,6 +456,17 @@ ID.
442 456 ClientInput and Acceptor are mutually exclusive. Enabling one
443 457 prohibits the other.
444 458
  459 +=item Domain
  460 +
  461 +Specifies the domain within which communication will take place. It
  462 +selects the protocol family which should be used. Currently supported
  463 +values are AF_INET, AF_INET6, PF_INET or PF_INET6. This parameter is
  464 +optional and will default to AF_INET if omitted.
  465 +
  466 +Note: AF_INET6 and PF_INET6 are supplied by the Socket6 module, which
  467 +is available on the CPAN. You must have Socket6 loaded before
  468 +POE::Component::Server::TCP will create IPv6 sockets.
  469 +
445 470 =item Error
446 471
447 472 Error is an optional coderef which will be called to handle server
177 lib/POE/Wheel/SocketFactory.pm
@@ -48,6 +48,11 @@ BEGIN {
48 48 eval '*F_GETFL = sub { 0 };';
49 49 eval '*F_SETFL = sub { 0 };';
50 50 }
  51 +
  52 + unless (exists $INC{"Socket6.pm"}) {
  53 + eval "*Socket6::AF_INET6 = sub { ~0 }";
  54 + eval "*Socket6::PF_INET6 = sub { ~0 }";
  55 + }
51 56 }
52 57
53 58 #------------------------------------------------------------------------------
@@ -55,13 +60,16 @@ BEGIN {
55 60 # same operations, it seems, and this is a way to add new ones with a
56 61 # minimum of additional code.
57 62
58   -sub DOM_UNIX () { 'unix' } # UNIX domain socket
59   -sub DOM_INET () { 'inet' } # INET domain socket
  63 +sub DOM_UNIX () { 'unix' } # UNIX domain socket
  64 +sub DOM_INET () { 'inet' } # INET domain socket
  65 +sub DOM_INET6 () { 'inet6' } # INET v6 domain socket
60 66
61 67 # AF_XYZ and PF_XYZ may be different.
62 68 my %map_family_to_domain =
63   - ( AF_UNIX, DOM_UNIX, PF_UNIX, DOM_UNIX,
64   - AF_INET, DOM_INET, PF_INET, DOM_INET,
  69 + ( AF_UNIX, DOM_UNIX, PF_UNIX, DOM_UNIX,
  70 + AF_INET, DOM_INET, PF_INET, DOM_INET,
  71 + &Socket6::AF_INET6, DOM_INET6,
  72 + &Socket6::PF_INET6, DOM_INET6,
65 73 );
66 74
67 75 sub SVROP_LISTENS () { 'listens' } # connect/listen sockets
@@ -70,19 +78,25 @@ sub SVROP_NOTHING () { 'nothing' } # connectionless sockets
70 78 # Map family/protocol pairs to connection or connectionless
71 79 # operations.
72 80 my %supported_protocol =
73   - ( DOM_UNIX, { none => SVROP_LISTENS },
74   - DOM_INET, { tcp => SVROP_LISTENS,
75   - udp => SVROP_NOTHING,
76   - },
  81 + ( DOM_UNIX, { none => SVROP_LISTENS },
  82 + DOM_INET, { tcp => SVROP_LISTENS,
  83 + udp => SVROP_NOTHING,
  84 + },
  85 + DOM_INET6, { tcp => SVROP_LISTENS,
  86 + udp => SVROP_NOTHING,
  87 + },
77 88 );
78 89
79 90 # Sane default socket types for each supported protocol. -><- Maybe
80 91 # this structure can be combined with %supported_protocol?
81 92 my %default_socket_type =
82   - ( DOM_UNIX, { none => SOCK_STREAM },
83   - DOM_INET, { tcp => SOCK_STREAM,
84   - udp => SOCK_DGRAM,
85   - },
  93 + ( DOM_UNIX, { none => SOCK_STREAM },
  94 + DOM_INET, { tcp => SOCK_STREAM,
  95 + udp => SOCK_DGRAM,
  96 + },
  97 + DOM_INET6, { tcp => SOCK_STREAM,
  98 + udp => SOCK_DGRAM,
  99 + },
86 100 );
87 101
88 102 #------------------------------------------------------------------------------
@@ -137,6 +151,10 @@ sub _define_accept_state {
137 151 elsif ( $domain eq DOM_INET ) {
138 152 ($peer_port, $peer_addr) = unpack_sockaddr_in($peer);
139 153 }
  154 + elsif ( $domain eq DOM_INET6 ) {
  155 + $peer = getpeername($new_socket);
  156 + ($peer_port, $peer_addr) = Socket6::unpack_sockaddr_in6($peer);
  157 + }
140 158 else {
141 159 die "sanity failure: socket domain == $domain";
142 160 }
@@ -232,6 +250,18 @@ sub _define_connect_state {
232 250 }
233 251 }
234 252
  253 + # INET6 socket stacks tend not to.
  254 + elsif ($domain eq DOM_INET6) {
  255 + if (defined $peer) {
  256 + eval {
  257 + ($peer_port, $peer_addr) = Socket6::unpack_sockaddr_in6($peer);
  258 + };
  259 + if (length $@) {
  260 + $peer_port = $peer_addr = undef;
  261 + }
  262 + }
  263 + }
  264 +
235 265 # What are we doing here?
236 266 else {
237 267 die "sanity failure: socket domain == $domain";
@@ -421,10 +451,9 @@ sub new {
421 451 );
422 452
423 453 # Default to Internet sockets.
424   - $self->[MY_SOCKET_DOMAIN] = ( (defined $params{SocketDomain})
425   - ? $params{SocketDomain}
426   - : AF_INET
427   - );
  454 + my $domain = delete $params{SocketDomain};
  455 + $domain = AF_INET unless defined $domain;
  456 + $self->[MY_SOCKET_DOMAIN] = $domain;
428 457
429 458 # Abstract the socket domain into something we don't have to keep
430 459 # testing duplicates of.
@@ -455,7 +484,9 @@ sub new {
455 484
456 485 # Internet sockets use protocols. Default the INET protocol to tcp,
457 486 # and try to resolve it.
458   - elsif ($abstract_domain eq DOM_INET) {
  487 + elsif ( $abstract_domain eq DOM_INET or
  488 + $abstract_domain eq DOM_INET6
  489 + ) {
459 490 my $socket_protocol =
460 491 (defined $params{SocketProtocol}) ? $params{SocketProtocol} : 'tcp';
461 492
@@ -588,7 +619,6 @@ sub new {
588 619 # context, and translate them into parameters that bind()
589 620 # understands.
590 621 if ($abstract_domain eq DOM_INET) {
591   -
592 622 # Don't bind if the creator doesn't specify a related parameter.
593 623 if ((defined $params{BindAddress}) or (defined $params{BindPort})) {
594 624
@@ -601,12 +631,14 @@ sub new {
601 631 {% use_bytes %}
602 632
603 633 # Resolve the bind address if it's not already packed.
604   - (length($bind_address) == 4)
605   - or ($bind_address = inet_aton($bind_address));
  634 + unless (length($bind_address) == 4) {
  635 + $bind_address = inet_aton($bind_address);
  636 + }
  637 +
606 638 unless (defined $bind_address) {
607 639 $! = EADDRNOTAVAIL;
608 640 $poe_kernel->yield( $event_failure,
609   - 'inet_aton', $!+0, $!, $self->[MY_UNIQUE_ID]
  641 + "inet_aton", $!+0, $!, $self->[MY_UNIQUE_ID]
610 642 );
611 643 return $self;
612 644 }
@@ -628,7 +660,59 @@ sub new {
628 660 $bind_address = pack_sockaddr_in($bind_port, $bind_address);
629 661 unless (defined $bind_address) {
630 662 $poe_kernel->yield( $event_failure,
631   - 'pack_sockaddr_in', $!+0, $!, $self->[MY_UNIQUE_ID]
  663 + "pack_sockaddr_in", $!+0, $!, $self->[MY_UNIQUE_ID]
  664 + );
  665 + return $self;
  666 + }
  667 + }
  668 + }
  669 +
  670 + # Check SocketFactory /Bind.*/ parameters in an Internet socket
  671 + # context, and translate them into parameters that bind()
  672 + # understands.
  673 + elsif ($abstract_domain eq DOM_INET6) {
  674 +
  675 + # Don't bind if the creator doesn't specify a related parameter.
  676 + if ((defined $params{BindAddress}) or (defined $params{BindPort})) {
  677 +
  678 + # Set the bind address, or default to INADDR_ANY.
  679 + $bind_address = ( (defined $params{BindAddress})
  680 + ? $params{BindAddress}
  681 + : Socket6::inaddr6_any()
  682 + );
  683 +
  684 + {% use_bytes %}
  685 +
  686 + # Resolve the bind address.
  687 + $bind_address =
  688 + Socket6::inet_pton($self->[MY_SOCKET_DOMAIN], $bind_address);
  689 + unless (defined $bind_address) {
  690 + $! = EADDRNOTAVAIL;
  691 + $poe_kernel->yield( $event_failure,
  692 + "inet_pton", $!+0, $!, $self->[MY_UNIQUE_ID]
  693 + );
  694 + return $self;
  695 + }
  696 +
  697 + # Set the bind port, or default to 0 (any) if none specified.
  698 + # Resolve it to a number, if at all possible.
  699 + my $bind_port = (defined $params{BindPort}) ? $params{BindPort} : 0;
  700 + if ($bind_port =~ /[^0-9]/) {
  701 + $bind_port = getservbyname($bind_port, $protocol_name);
  702 + unless (defined $bind_port) {
  703 + $! = EADDRNOTAVAIL;
  704 + $poe_kernel->yield( $event_failure,
  705 + 'getservbyname', $!+0, $!, $self->[MY_UNIQUE_ID]
  706 + );
  707 + return $self;
  708 + }
  709 + }
  710 +
  711 + $bind_address = Socket6::pack_sockaddr_in6($bind_port, $bind_address);
  712 + unless (defined $bind_address) {
  713 + $poe_kernel->yield( $event_failure,
  714 + "pack_sockaddr_in6", $!+0, $!,
  715 + $self->[MY_UNIQUE_ID]
632 716 );
633 717 return $self;
634 718 }
@@ -690,7 +774,9 @@ sub new {
690 774 # Check SocketFactory /Remote.*/ parameters in an Internet socket
691 775 # context, and translate them into parameters that connect()
692 776 # understands.
693   - if ($abstract_domain eq DOM_INET) {
  777 + if ($abstract_domain eq DOM_INET or
  778 + $abstract_domain eq DOM_INET6
  779 + ) {
694 780 # connecting if RemoteAddress
695 781 croak 'RemotePort required' unless (defined $params{RemotePort});
696 782 carp 'ListenQueue ignored' if (defined $params{ListenQueue});
@@ -706,20 +792,47 @@ sub new {
706 792 }
707 793 }
708 794
709   - $connect_address = inet_aton($params{RemoteAddress});
  795 + my $error_tag;
  796 + if ($abstract_domain eq DOM_INET) {
  797 + $connect_address = inet_aton($params{RemoteAddress});
  798 + $error_tag = "inet_aton";
  799 + }
  800 + elsif ($abstract_domain eq DOM_INET6) {
  801 + $connect_address =
  802 + Socket6::inet_pton( $self->[MY_SOCKET_DOMAIN],
  803 + $params{RemoteAddress}
  804 + );
  805 + $error_tag = "inet_pton";
  806 + }
  807 + else {
  808 + die "unknown domain $abstract_domain";
  809 + }
  810 +
710 811 unless (defined $connect_address) {
711 812 $! = EADDRNOTAVAIL;
712 813 $poe_kernel->yield( $event_failure,
713   - 'inet_aton', $!+0, $!, $self->[MY_UNIQUE_ID]
  814 + $error_tag, $!+0, $!, $self->[MY_UNIQUE_ID]
714 815 );
715 816 return $self;
716 817 }
717 818
718   - $connect_address = pack_sockaddr_in($remote_port, $connect_address);
  819 + if ($abstract_domain eq DOM_INET) {
  820 + $connect_address = pack_sockaddr_in($remote_port, $connect_address);
  821 + $error_tag = "pack_sockaddr_in";
  822 + }
  823 + elsif ($abstract_domain eq DOM_INET6) {
  824 + $connect_address =
  825 + Socket6::pack_sockaddr_in6($remote_port, $connect_address);
  826 + $error_tag = "pack_sockaddr_in6";
  827 + }
  828 + else {
  829 + die "unknown domain $abstract_domain";
  830 + }
  831 +
719 832 unless ($connect_address) {
720 833 $! = EADDRNOTAVAIL;
721 834 $poe_kernel->yield( $event_failure,
722   - 'pack_sockaddr_in', $!+0, $!, $self->[MY_UNIQUE_ID]
  835 + $error_tag, $!+0, $!, $self->[MY_UNIQUE_ID]
723 836 );
724 837 return $self;
725 838 }
@@ -965,8 +1078,12 @@ call.
965 1078 =item SocketDomain
966 1079
967 1080 SocketDomain supplies socket() with its DOMAIN parameter. Supported
968   -values are AF_UNIX, AF_INET, PF_UNIX and PF_INET. If SocketDomain is
969   -omitted, it defaults to AF_INET.
  1081 +values are AF_UNIX, AF_INET, AF_INET6, PF_UNIX, PF_INET, and PF_INET6.
  1082 +If SocketDomain is omitted, it defaults to AF_INET.
  1083 +
  1084 +Note: AF_INET6 and PF_INET6 are supplied by the Socket6 module, which
  1085 +is available on the CPAN. You must have Socket6 loaded before
  1086 +SocketFactory can create IPv6 sockets.
970 1087
971 1088 =item SocketType
972 1089
@@ -1150,7 +1267,7 @@ A sample ErrorEvent handler:
1150 1267
1151 1268 =head1 SEE ALSO
1152 1269
1153   -POE::Wheel.
  1270 +POE::Wheel, Socket6.
1154 1271
1155 1272 The SEE ALSO section in L<POE> contains a table of contents covering
1156 1273 the entire POE distribution.
5 mylib/Makefile-5005.pm
@@ -55,6 +55,11 @@ ExtUtils::AutoInstall->import
55 55 -tests => [ qw(t/27_poll.t) ],
56 56 'IO::Poll' => 0.05,
57 57 ],
  58 + "Optional modules for IPv6 support." => [
  59 + -default => 0,
  60 + -tests => [ qw(t/29_sockfact6.t) ],
  61 + 'Socket6' => 0.11,
  62 + ],
58 63 "Optional modules for controlling full-screen programs (e.g. vi)." => [
59 64 -default => 0,
60 65 'IO::Pty' => '1.02',

0 comments on commit 64c395f

Please sign in to comment.
Something went wrong with that request. Please try again.