Coro/Coro/Socket.pm

=head1 NAME

Coro::Socket - non-blocking socket-I/O

=head1 SYNOPSIS

 use Coro::Socket;

 # listen on an ipv4 socket
 my $socket = new Coro::Socket PeerHost => "localhost",
                               PeerPort => 'finger';

 # listen on any other type of socket
 my $socket = Coro::Socket->new_from_fh
                 (IO::Socket::UNIX->new
                     Local  => "/tmp/socket",
                     Type   => SOCK_STREAM,
                 );

=head1 DESCRIPTION

This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.

This module implements socket-handles in a coroutine-compatible way,
that is, other coroutines can run while reads or writes block on the
handle. See L<Coro::Handle>, especially the note about prefering method
calls.

=head1 IPV6 WARNING

This module was written to imitate the L<IO::Socket::INET> API, and derive
from it. Since IO::Socket::INET does not support IPv6, this module does
neither.

Therefore it is not recommended to use Coro::Socket in new code. Instead,
use L<AnyEvent::Socket> and L<Coro::Handle>, e.g.:

   use Coro;
   use Coro::Handle;
   use AnyEvent::Socket;

   # use tcp_connect from AnyEvent::Socket
   # and call Coro::Handle::unblock on it.

   tcp_connect "www.google.com", 80, Coro::rouse_cb;
   my $fh = unblock +(Coro::rouse_wait)[0];

   # now we have a perfectly thread-safe socket handle in $fh
   print $fh "GET / HTTP/1.0\015\012\015\012";
   local $/;
   print <$fh>;

Using C<AnyEvent::Socket::tcp_connect> gives you transparent IPv6,
multi-homing, SRV-record etc. support.

For listening sockets, use C<AnyEvent::Socket::tcp_server>.

=over 4

=cut

package Coro::Socket;

no warnings "uninitialized";

use strict;

use Errno ();
use Carp qw(croak);
use Socket;
use IO::Socket::INET ();

use Coro::Util ();

use base qw(Coro::Handle IO::Socket::INET);

our $VERSION = 5.15;

our (%_proto, %_port);

sub _proto($) {
   $_proto{$_[0]} ||= do {
      ((getprotobyname $_[0])[2] || (getprotobynumber $_[0])[2])
         or croak "unsupported protocol: $_[0]";
   };
}

sub _port($$) {
   $_port{$_[0],$_[1]} ||= do {
      return $_[0] if $_[0] =~ /^\d+$/;

      $_[0] =~ /([^(]+)\s*(?:\((\d+)\))?/x
         or croak "unparsable port number: $_[0]";
      ((getservbyname $1, $_[1])[2]
        || (getservbyport $1, $_[1])[2]
        || $2)
         or croak "unknown port: $_[0]";
   };
}

sub _sa($$$) {
   my ($host, $port, $proto) = @_;

   $port or $host =~ s/:([^:]+)$// and $port = $1;

   my $_proto = _proto($proto);
   my $_port = _port($port, $proto);

   my $_host = Coro::Util::inet_aton $host
      or croak "$host: unable to resolve";

   pack_sockaddr_in $_port, $_host
}

=item $fh = new Coro::Socket param => value, ...

Create a new non-blocking tcp handle and connect to the given host
and port. The parameter names and values are mostly the same as for
IO::Socket::INET (as ugly as I think they are).

The parameters officially supported currently are: C<ReuseAddr>,
C<LocalPort>, C<LocalHost>, C<PeerPort>, C<PeerHost>, C<Listen>, C<Timeout>,
C<SO_RCVBUF>, C<SO_SNDBUF>.

   $fh = new Coro::Socket PeerHost => "localhost", PeerPort => 'finger';

=cut

sub _prepare_socket {
   my ($self, $arg) = @_;

   $self
}
   
sub new {
   my ($class, %arg) = @_;

   $arg{Proto}     ||= 'tcp';
   $arg{LocalHost} ||= delete $arg{LocalAddr};
   $arg{PeerHost}  ||= delete $arg{PeerAddr};
   defined ($arg{Type}) or $arg{Type} = $arg{Proto} eq "tcp" ? SOCK_STREAM : SOCK_DGRAM;

   socket my $fh, PF_INET, $arg{Type}, _proto ($arg{Proto})
      or return;

   my $self = bless Coro::Handle->new_from_fh (
      $fh,
      timeout       => $arg{Timeout},
      forward_class => $arg{forward_class},
      partial       => $arg{partial},
   ), $class
      or return;

   $self->configure (\%arg)
}

sub configure {
   my ($self, $arg) = @_;

   if ($arg->{ReuseAddr}) {
      $self->setsockopt (SOL_SOCKET, SO_REUSEADDR, 1)
         or croak "setsockopt(SO_REUSEADDR): $!";
   }

   if ($arg->{ReusePort}) {
      $self->setsockopt (SOL_SOCKET, SO_REUSEPORT, 1)
         or croak "setsockopt(SO_REUSEPORT): $!";
   }

   if ($arg->{Broadcast}) {
      $self->setsockopt (SOL_SOCKET, SO_BROADCAST, 1)
         or croak "setsockopt(SO_BROADCAST): $!";
   }

   if ($arg->{SO_RCVBUF}) {
      $self->setsockopt (SOL_SOCKET, SO_RCVBUF, $arg->{SO_RCVBUF})
         or croak "setsockopt(SO_RCVBUF): $!";
   }

   if ($arg->{SO_SNDBUF}) {
      $self->setsockopt (SOL_SOCKET, SO_SNDBUF, $arg->{SO_SNDBUF})
         or croak "setsockopt(SO_SNDBUF): $!";
   }

   if ($arg->{LocalPort} || $arg->{LocalHost}) {
      my @sa = _sa($arg->{LocalHost} || "0.0.0.0", $arg->{LocalPort} || 0, $arg->{Proto});
      $self->bind ($sa[0])
         or croak "bind($arg->{LocalHost}:$arg->{LocalPort}): $!";
   }

   if ($arg->{PeerHost}) {
      my @sa = _sa ($arg->{PeerHost}, $arg->{PeerPort}, $arg->{Proto});

      for (@sa) {
         $! = 0;

         if ($self->connect ($_)) {
            next unless writable $self;
            $! = unpack "i", $self->getsockopt (SOL_SOCKET, SO_ERROR);
         }

         $! or last;

         $!{ECONNREFUSED} or $!{ENETUNREACH} or $!{ETIMEDOUT} or $!{EHOSTUNREACH}
            or return;
      }
   } elsif (exists $arg->{Listen}) {
      $self->listen ($arg->{Listen})
         or return;
   }

   $self
}

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.52
Committed:	Tue Jun 30 08:28:55 2009 UTC (14 years, 11 months ago) by root
Branch:	MAIN
CVS Tags:	rel-5_15
Changes since 1.51:	+1 -1 lines
Log Message:	5.15
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.43	Coro::Socket - non-blocking socket-I/O
4	root	1.1
5			=head1 SYNOPSIS
6
7			use Coro::Socket;
8
9	root	1.14	# listen on an ipv4 socket
10			my $socket = new Coro::Socket PeerHost => "localhost",
11			PeerPort => 'finger';
12
13			# listen on any other type of socket
14			my $socket = Coro::Socket->new_from_fh
15			(IO::Socket::UNIX->new
16			Local => "/tmp/socket",
17			Type => SOCK_STREAM,
18			);
19
20	root	1.1	=head1 DESCRIPTION
21
22	root	1.20	This module is an L<AnyEvent> user, you need to make sure that you use and
23			run a supported event loop.
24
25	root	1.1	This module implements socket-handles in a coroutine-compatible way,
26			that is, other coroutines can run while reads or writes block on the
27	root	1.17	handle. See L<Coro::Handle>, especially the note about prefering method
28			calls.
29	root	1.1
30	root	1.51	=head1 IPV6 WARNING
31
32			This module was written to imitate the L<IO::Socket::INET> API, and derive
33			from it. Since IO::Socket::INET does not support IPv6, this module does
34			neither.
35
36			Therefore it is not recommended to use Coro::Socket in new code. Instead,
37			use L<AnyEvent::Socket> and L<Coro::Handle>, e.g.:
38
39			use Coro;
40			use Coro::Handle;
41			use AnyEvent::Socket;
42
43			# use tcp_connect from AnyEvent::Socket
44			# and call Coro::Handle::unblock on it.
45
46			tcp_connect "www.google.com", 80, Coro::rouse_cb;
47			my $fh = unblock +(Coro::rouse_wait)[0];
48
49			# now we have a perfectly thread-safe socket handle in $fh
50			print $fh "GET / HTTP/1.0\015\012\015\012";
51			local $/;
52			print <$fh>;
53
54			Using C<AnyEvent::Socket::tcp_connect> gives you transparent IPv6,
55			multi-homing, SRV-record etc. support.
56
57			For listening sockets, use C<AnyEvent::Socket::tcp_server>.
58
59	root	1.1	=over 4
60
61			=cut
62
63			package Coro::Socket;
64
65	root	1.14	no warnings "uninitialized";
66
67			use strict;
68
69	root	1.1	use Errno ();
70			use Carp qw(croak);
71			use Socket;
72	root	1.14	use IO::Socket::INET ();
73	root	1.1
74	root	1.6	use Coro::Util ();
75
76	root	1.14	use base qw(Coro::Handle IO::Socket::INET);
77
78	root	1.52	our $VERSION = 5.15;
79	root	1.1
80	root	1.14	our (%_proto, %_port);
81	root	1.1
82			sub _proto($) {
83			$_proto{$_[0]} \|\|= do {
84			((getprotobyname $_[0])[2] \|\| (getprotobynumber $_[0])[2])
85			or croak "unsupported protocol: $_[0]";
86			};
87			}
88
89			sub _port($$) {
90	root	1.9	$_port{$_[0],$_[1]} \|\|= do {
91			return $_[0] if $_[0] =~ /^\d+$/;
92
93			$_[0] =~ /([^(]+)\s*(?:\((\d+)\))?/x
94			or croak "unparsable port number: $_[0]";
95			((getservbyname $1, $_[1])[2]
96			\|\| (getservbyport $1, $_[1])[2]
97			\|\| $2)
98	root	1.1	or croak "unknown port: $_[0]";
99			};
100			}
101
102			sub _sa($$$) {
103			my ($host, $port, $proto) = @_;
104	root	1.22
105	root	1.14	$port or $host =~ s/:([^:]+)$// and $port = $1;
106	root	1.22
107	root	1.1	my $_proto = _proto($proto);
108			my $_port = _port($port, $proto);
109
110	root	1.22	my $_host = Coro::Util::inet_aton $host
111			or croak "$host: unable to resolve";
112
113			pack_sockaddr_in $_port, $_host
114	root	1.1	}
115
116	root	1.14	=item $fh = new Coro::Socket param => value, ...
117	root	1.1
118			Create a new non-blocking tcp handle and connect to the given host
119	root	1.21	and port. The parameter names and values are mostly the same as for
120	root	1.1	IO::Socket::INET (as ugly as I think they are).
121
122	root	1.21	The parameters officially supported currently are: C<ReuseAddr>,
123	root	1.48	C<LocalPort>, C<LocalHost>, C<PeerPort>, C<PeerHost>, C<Listen>, C<Timeout>,
124			C<SO_RCVBUF>, C<SO_SNDBUF>.
125	root	1.1
126	root	1.14	$fh = new Coro::Socket PeerHost => "localhost", PeerPort => 'finger';
127	root	1.1
128			=cut
129
130			sub _prepare_socket {
131	root	1.14	my ($self, $arg) = @_;
132
133			$self
134			}
135
136			sub new {
137			my ($class, %arg) = @_;
138	root	1.1
139	root	1.14	$arg{Proto} \|\|= 'tcp';
140			$arg{LocalHost} \|\|= delete $arg{LocalAddr};
141			$arg{PeerHost} \|\|= delete $arg{PeerAddr};
142			defined ($arg{Type}) or $arg{Type} = $arg{Proto} eq "tcp" ? SOCK_STREAM : SOCK_DGRAM;
143
144			socket my $fh, PF_INET, $arg{Type}, _proto ($arg{Proto})
145	root	1.1	or return;
146
147	root	1.14	my $self = bless Coro::Handle->new_from_fh (
148			$fh,
149			timeout => $arg{Timeout},
150			forward_class => $arg{forward_class},
151			partial => $arg{partial},
152			), $class
153	root	1.1	or return;
154
155	root	1.14	$self->configure (\%arg)
156			}
157
158			sub configure {
159			my ($self, $arg) = @_;
160
161	root	1.1	if ($arg->{ReuseAddr}) {
162	root	1.14	$self->setsockopt (SOL_SOCKET, SO_REUSEADDR, 1)
163	root	1.1	or croak "setsockopt(SO_REUSEADDR): $!";
164			}
165
166			if ($arg->{ReusePort}) {
167	root	1.14	$self->setsockopt (SOL_SOCKET, SO_REUSEPORT, 1)
168	root	1.1	or croak "setsockopt(SO_REUSEPORT): $!";
169			}
170
171	root	1.18	if ($arg->{Broadcast}) {
172			$self->setsockopt (SOL_SOCKET, SO_BROADCAST, 1)
173			or croak "setsockopt(SO_BROADCAST): $!";
174			}
175
176	root	1.48	if ($arg->{SO_RCVBUF}) {
177			$self->setsockopt (SOL_SOCKET, SO_RCVBUF, $arg->{SO_RCVBUF})
178			or croak "setsockopt(SO_RCVBUF): $!";
179			}
180
181			if ($arg->{SO_SNDBUF}) {
182			$self->setsockopt (SOL_SOCKET, SO_SNDBUF, $arg->{SO_SNDBUF})
183			or croak "setsockopt(SO_SNDBUF): $!";
184			}
185
186	root	1.14	if ($arg->{LocalPort} \|\| $arg->{LocalHost}) {
187			my @sa = _sa($arg->{LocalHost} \|\| "0.0.0.0", $arg->{LocalPort} \|\| 0, $arg->{Proto});
188			$self->bind ($sa[0])
189	root	1.1	or croak "bind($arg->{LocalHost}:$arg->{LocalPort}): $!";
190			}
191
192	root	1.14	if ($arg->{PeerHost}) {
193			my @sa = _sa ($arg->{PeerHost}, $arg->{PeerPort}, $arg->{Proto});
194	root	1.1
195			for (@sa) {
196			$! = 0;
197
198	root	1.14	if ($self->connect ($_)) {
199			next unless writable $self;
200			$! = unpack "i", $self->getsockopt (SOL_SOCKET, SO_ERROR);
201	root	1.1	}
202
203			$! or last;
204
205			$!{ECONNREFUSED} or $!{ENETUNREACH} or $!{ETIMEDOUT} or $!{EHOSTUNREACH}
206			or return;
207			}
208	root	1.14	} elsif (exists $arg->{Listen}) {
209			$self->listen ($arg->{Listen})
210	root	1.1	or return;
211			}
212
213	root	1.14	$self
214	root	1.1	}
215
216			1;
217
218	root	1.14	=back
219
220	root	1.1	=head1 AUTHOR
221
222	root	1.14	Marc Lehmann <schmorp@schmorp.de>
223			http://home.schmorp.de/
224	root	1.1
225			=cut
226