Coro/Coro/Socket.pm

=head1 NAME

Coro::Socket - non-blocking socket-io

=head1 SYNOPSIS

 use Coro::Socket;

=head1 DESCRIPTION

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

=over 4

=cut

package Coro::Socket;

use Errno ();
use Carp qw(croak);
use Socket;

use Coro::Util ();

use base 'Coro::Handle';

$VERSION = 0.13;

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

sub _port($$) {
   $_port{$_[0]} ||= do {
      ((getservbyname $_[0], $_[1])[2] || (getservbyport $_[0], $_[1])[2])
         or croak "unknown port: $_[0]";
   };
}

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

   # optimize this a bit for a common case
   if ($host =~ /^(25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?)
                \.(25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?)
                \.(25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?)
                \.(25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?)$/) {
      return pack_sockaddr_in($_port, inet_aton $host);
   } else {
      my (undef, undef, undef, undef, @host) = Coro::Util::gethostbyname $host
         or croak "unknown host: $host";
      map pack_sockaddr_in($_port,$_), @host;
   }
}

=item $fh = new_inet 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 in
IO::Socket::INET (as ugly as I think they are).

If the host is unreachable or otherwise cannot be connected to this method
returns undef. On all other errors ot croak's.

Multihomed is always enabled.

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

=cut

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

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

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

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

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

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

   $fh;
}
   
sub new {
   my $class = shift;
   my %arg = @_;
   my $fh;

   $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;

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

      for (@sa) {
         $fh = $class->_prepare_socket(\%arg)
            or return;

         $! = 0;

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

         $! or last;

         $!{ECONNREFUSED} or $!{ENETUNREACH} or $!{ETIMEDOUT} or $!{EHOSTUNREACH}
            or return;
      }
   } else {
      $fh = $class->_prepare_socket(\%arg)
         or return;
      if (exists $arg{Listen}) {
         $fh->listen($arg{Listen})
            or return;
      }
   }

   $fh;
}

=item connect, listen, bind, accept, getsockopt, setsockopt,
send, recv, getpeername, getsockname

Do the same thing as the perl builtins (but return true on
EINPROGRESS). Remember that these must be method calls.

=cut

sub connect     { connect tied(${$_[0]})->{fh}, $_[1] or $! == Errno::EINPROGRESS }
sub bind        { bind    tied(${$_[0]})->{fh}, $_[1] }
sub listen      { listen  tied(${$_[0]})->{fh}, $_[1] }
sub getsockopt  { getsockopt tied(${$_[0]})->{fh}, $_[1], $_[2] }
sub setsockopt  { setsockopt tied(${$_[0]})->{fh}, $_[1], $_[2], $_[3] }
sub send        { send tied(${$_[0]})->{fh}, $_[1], $_[2], @_ > 2 ? $_[3] : () }
sub recv        { recv tied(${$_[0]})->{fh}, $_[1], $_[2], @_ > 2 ? $_[3] : () }
sub getsockname { getsockname tied(${$_[0]})->{fh} }
sub getpeername { getpeername tied(${$_[0]})->{fh} }

sub accept {
   my $fh;
   while () {
      $_[0]->readable or return;
      accept $fh, tied(${$_[0]})->{fh}
         and return new_from_fh Coro::Socket $fh;
      return unless $!{EAGAIN};
   }
}

1;

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

Revision:	1.8
Committed:	Thu Aug 9 02:57:54 2001 UTC (22 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.7:	+3 -3 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::Socket - non-blocking socket-io
4
5			=head1 SYNOPSIS
6
7			use Coro::Socket;
8
9			=head1 DESCRIPTION
10
11			This module implements socket-handles in a coroutine-compatible way,
12			that is, other coroutines can run while reads or writes block on the
13			handle. L<Coro::Handle>.
14
15			=over 4
16
17			=cut
18
19			package Coro::Socket;
20
21			use Errno ();
22			use Carp qw(croak);
23			use Socket;
24
25	root	1.6	use Coro::Util ();
26
27	root	1.1	use base 'Coro::Handle';
28
29	root	1.6	$VERSION = 0.13;
30	root	1.1
31			sub _proto($) {
32			$_proto{$_[0]} \|\|= do {
33			((getprotobyname $_[0])[2] \|\| (getprotobynumber $_[0])[2])
34			or croak "unsupported protocol: $_[0]";
35			};
36			}
37
38			sub _port($$) {
39			$_port{$_[0]} \|\|= do {
40			((getservbyname $_[0], $_[1])[2] \|\| (getservbyport $_[0], $_[1])[2])
41			or croak "unknown port: $_[0]";
42			};
43			}
44
45			sub _sa($$$) {
46			my ($host, $port, $proto) = @_;
47			my $_proto = _proto($proto);
48			my $_port = _port($port, $proto);
49
50	root	1.6	# optimize this a bit for a common case
51			if ($host =~ /^(25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
52			\.(25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
53			\.(25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
54			\.(25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)$/) {
55			return pack_sockaddr_in($_port, inet_aton $host);
56			} else {
57			my (undef, undef, undef, undef, @host) = Coro::Util::gethostbyname $host
58			or croak "unknown host: $host";
59			map pack_sockaddr_in($_port,$_), @host;
60			}
61	root	1.1	}
62
63			=item $fh = new_inet Coro::Socket param => value, ...
64
65			Create a new non-blocking tcp handle and connect to the given host
66			and port. The parameter names and values are mostly the same as in
67			IO::Socket::INET (as ugly as I think they are).
68
69			If the host is unreachable or otherwise cannot be connected to this method
70			returns undef. On all other errors ot croak's.
71
72			Multihomed is always enabled.
73
74			$fh = new_inet Coro::Socket PeerHost => "localhost", PeerPort => 'finger';
75
76			=cut
77
78			sub _prepare_socket {
79			my ($class, $arg) = @_;
80			my $fh;
81
82			socket $fh, PF_INET, $arg->{Type}, _proto($arg->{Proto})
83			or return;
84
85	root	1.7	$fh = bless Coro::Handle->new_from_fh($fh, timeout => $arg{Timeout}), $class
86	root	1.1	or return;
87
88			if ($arg->{ReuseAddr}) {
89			$fh->setsockopt(SOL_SOCKET, SO_REUSEADDR, 1)
90			or croak "setsockopt(SO_REUSEADDR): $!";
91			}
92
93			if ($arg->{ReusePort}) {
94			$fh->setsockopt(SOL_SOCKET, SO_REUSEPORT, 1)
95			or croak "setsockopt(SO_REUSEPORT): $!";
96			}
97
98	root	1.6	if ($arg->{LocalPort}) {
99			my @sa = _sa($arg->{LocalHost} \|\| "0.0.0.0", $arg->{LocalPort}, $arg->{Proto});
100	root	1.1	$fh->bind($sa[0])
101			or croak "bind($arg->{LocalHost}:$arg->{LocalPort}): $!";
102			}
103
104			$fh;
105			}
106
107	root	1.5	sub new {
108	root	1.1	my $class = shift;
109			my %arg = @_;
110			my $fh;
111
112			$arg{Proto} \|\|= 'tcp';
113			$arg{LocalHost} \|\|= delete $arg{LocalAddr};
114			$arg{PeerHost} \|\|= delete $arg{PeerAddr};
115			defined ($arg{Type}) or $arg{Type} = $arg{Proto} eq "tcp" ? SOCK_STREAM : SOCK_DGRAM;
116
117			if ($arg{PeerHost}) {
118			my @sa = _sa($arg{PeerHost}, $arg{PeerPort}, $arg{Proto});
119
120			for (@sa) {
121			$fh = $class->_prepare_socket(\%arg)
122			or return;
123
124			$! = 0;
125
126			if ($fh->connect($_)) {
127			next unless writable $fh;
128			$! = unpack "i", $fh->getsockopt(SOL_SOCKET, SO_ERROR);
129			}
130
131			$! or last;
132
133			$!{ECONNREFUSED} or $!{ENETUNREACH} or $!{ETIMEDOUT} or $!{EHOSTUNREACH}
134			or return;
135			}
136			} else {
137			$fh = $class->_prepare_socket(\%arg)
138			or return;
139	root	1.7	if (exists $arg{Listen}) {
140			$fh->listen($arg{Listen})
141			or return;
142			}
143	root	1.1	}
144
145			$fh;
146			}
147
148	root	1.2	=item connect, listen, bind, accept, getsockopt, setsockopt,
149	root	1.7	send, recv, getpeername, getsockname
150	root	1.1
151			Do the same thing as the perl builtins (but return true on
152			EINPROGRESS). Remember that these must be method calls.
153
154			=cut
155
156			sub connect { connect tied(${$_[0]})->{fh}, $_[1] or $! == Errno::EINPROGRESS }
157			sub bind { bind tied(${$_[0]})->{fh}, $_[1] }
158			sub listen { listen tied(${$_[0]})->{fh}, $_[1] }
159			sub getsockopt { getsockopt tied(${$_[0]})->{fh}, $_[1], $_[2] }
160			sub setsockopt { setsockopt tied(${$_[0]})->{fh}, $_[1], $_[2], $_[3] }
161			sub send { send tied(${$_[0]})->{fh}, $_[1], $_[2], @_ > 2 ? $_[3] : () }
162			sub recv { recv tied(${$_[0]})->{fh}, $_[1], $_[2], @_ > 2 ? $_[3] : () }
163	root	1.8	sub getsockname { getsockname tied(${$_[0]})->{fh} }
164			sub getpeername { getpeername tied(${$_[0]})->{fh} }
165	root	1.1
166			sub accept {
167			my $fh;
168	root	1.7	while () {
169			$_[0]->readable or return;
170			accept $fh, tied(${$_[0]})->{fh}
171	root	1.8	and return new_from_fh Coro::Socket $fh;
172	root	1.7	return unless $!{EAGAIN};
173			}
174	root	1.1	}
175
176			1;
177
178			=head1 AUTHOR
179
180			Marc Lehmann <pcg@goof.com>
181			http://www.goof.com/pcg/marc/
182
183			=cut
184