ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Event/Socket.pm
Revision: 1.42
Committed: Mon Nov 20 22:26:16 2006 UTC (17 years, 11 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.41: +0 -0 lines
State: FILE REMOVED
Log Message:
*** empty log message ***

File Contents

# Content
1 =head1 NAME
2
3 Coro::Socket - non-blocking socket-io
4
5 =head1 SYNOPSIS
6
7 use Coro::Socket;
8
9 # 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 =head1 DESCRIPTION
21
22 This module implements socket-handles in a coroutine-compatible way,
23 that is, other coroutines can run while reads or writes block on the
24 handle. L<Coro::Handle>.
25
26 =over 4
27
28 =cut
29
30 package Coro::Socket;
31
32 no warnings "uninitialized";
33
34 use strict;
35
36 use Errno ();
37 use Carp qw(croak);
38 use Socket;
39 use IO::Socket::INET ();
40
41 use Coro::Util ();
42
43 use base qw(Coro::Handle IO::Socket::INET);
44
45 our $VERSION = 1.9;
46
47 our (%_proto, %_port);
48
49 sub _proto($) {
50 $_proto{$_[0]} ||= do {
51 ((getprotobyname $_[0])[2] || (getprotobynumber $_[0])[2])
52 or croak "unsupported protocol: $_[0]";
53 };
54 }
55
56 sub _port($$) {
57 $_port{$_[0],$_[1]} ||= do {
58 return $_[0] if $_[0] =~ /^\d+$/;
59
60 $_[0] =~ /([^(]+)\s*(?:\((\d+)\))?/x
61 or croak "unparsable port number: $_[0]";
62 ((getservbyname $1, $_[1])[2]
63 || (getservbyport $1, $_[1])[2]
64 || $2)
65 or croak "unknown port: $_[0]";
66 };
67 }
68
69 sub _sa($$$) {
70 my ($host, $port, $proto) = @_;
71 $port or $host =~ s/:([^:]+)$// and $port = $1;
72 my $_proto = _proto($proto);
73 my $_port = _port($port, $proto);
74
75 # optimize this a bit for a common case
76 if (Coro::Util::dotted_quad $host) {
77 return pack_sockaddr_in ($_port, inet_aton $host);
78 } else {
79 my (undef, undef, undef, undef, @host) = Coro::Util::gethostbyname $host
80 or croak "unknown host: $host";
81 map pack_sockaddr_in ($_port,$_), @host;
82 }
83 }
84
85 =item $fh = new Coro::Socket param => value, ...
86
87 Create a new non-blocking tcp handle and connect to the given host
88 and port. The parameter names and values are mostly the same as in
89 IO::Socket::INET (as ugly as I think they are).
90
91 If the host is unreachable or otherwise cannot be connected to this method
92 returns undef. On all other errors ot croak's.
93
94 Multihomed is always enabled.
95
96 $fh = new Coro::Socket PeerHost => "localhost", PeerPort => 'finger';
97
98 =cut
99
100 sub _prepare_socket {
101 my ($self, $arg) = @_;
102
103 $self
104 }
105
106 sub new {
107 my ($class, %arg) = @_;
108
109 $arg{Proto} ||= 'tcp';
110 $arg{LocalHost} ||= delete $arg{LocalAddr};
111 $arg{PeerHost} ||= delete $arg{PeerAddr};
112 defined ($arg{Type}) or $arg{Type} = $arg{Proto} eq "tcp" ? SOCK_STREAM : SOCK_DGRAM;
113
114 socket my $fh, PF_INET, $arg{Type}, _proto ($arg{Proto})
115 or return;
116
117 my $self = bless Coro::Handle->new_from_fh (
118 $fh,
119 timeout => $arg{Timeout},
120 forward_class => $arg{forward_class},
121 partial => $arg{partial},
122 ), $class
123 or return;
124
125 $self->configure (\%arg)
126 }
127
128 sub configure {
129 my ($self, $arg) = @_;
130
131 if ($arg->{ReuseAddr}) {
132 $self->setsockopt (SOL_SOCKET, SO_REUSEADDR, 1)
133 or croak "setsockopt(SO_REUSEADDR): $!";
134 }
135
136 if ($arg->{ReusePort}) {
137 $self->setsockopt (SOL_SOCKET, SO_REUSEPORT, 1)
138 or croak "setsockopt(SO_REUSEPORT): $!";
139 }
140
141 if ($arg->{LocalPort} || $arg->{LocalHost}) {
142 my @sa = _sa($arg->{LocalHost} || "0.0.0.0", $arg->{LocalPort} || 0, $arg->{Proto});
143 $self->bind ($sa[0])
144 or croak "bind($arg->{LocalHost}:$arg->{LocalPort}): $!";
145 }
146
147 if ($arg->{PeerHost}) {
148 my @sa = _sa ($arg->{PeerHost}, $arg->{PeerPort}, $arg->{Proto});
149
150 for (@sa) {
151 $! = 0;
152
153 if ($self->connect ($_)) {
154 next unless writable $self;
155 $! = unpack "i", $self->getsockopt (SOL_SOCKET, SO_ERROR);
156 }
157
158 $! or last;
159
160 $!{ECONNREFUSED} or $!{ENETUNREACH} or $!{ETIMEDOUT} or $!{EHOSTUNREACH}
161 or return;
162 }
163 } elsif (exists $arg->{Listen}) {
164 $self->listen ($arg->{Listen})
165 or return;
166 }
167
168 1
169 }
170
171 =item connect, listen, bind, getsockopt, setsockopt,
172 send, recv, peername, sockname, shutdown, peerport, peerhost
173
174 Do the same thing as the perl builtins or IO::Socket methods (but return
175 true on EINPROGRESS). Remember that these must be method calls.
176
177 =cut
178
179 sub connect { connect tied(${$_[0]})->[0], $_[1] or $! == Errno::EINPROGRESS }
180 sub bind { bind tied(${$_[0]})->[0], $_[1] }
181 sub listen { listen tied(${$_[0]})->[0], $_[1] }
182 sub getsockopt { getsockopt tied(${$_[0]})->[0], $_[1], $_[2] }
183 sub setsockopt { setsockopt tied(${$_[0]})->[0], $_[1], $_[2], $_[3] }
184 sub send { send tied(${$_[0]})->[0], $_[1], $_[2], @_ > 2 ? $_[3] : () }
185 sub recv { recv tied(${$_[0]})->[0], $_[1], $_[2], @_ > 2 ? $_[3] : () }
186 sub sockname { getsockname tied(${$_[0]})->[0] }
187 sub peername { getpeername tied(${$_[0]})->[0] }
188 sub shutdown { shutdown tied(${$_[0]})->[0], $_[1] }
189
190 =item ($fh, $peername) = $listen_fh->accept
191
192 In scalar context, returns the newly accepted socket (or undef) and in
193 list context return the ($fh, $peername) pair (or nothing).
194
195 =cut
196
197 sub accept {
198 my ($peername, $fh);
199 while () {
200 $peername = accept $fh, tied(${$_[0]})->[0]
201 and return wantarray
202 ? ($_[0]->new_from_fh($fh), $peername)
203 : $_[0]->new_from_fh($fh);
204
205 return unless $!{EAGAIN};
206
207 $_[0]->readable or return;
208 }
209 }
210
211 1;
212
213 =back
214
215 =head1 AUTHOR
216
217 Marc Lehmann <schmorp@schmorp.de>
218 http://home.schmorp.de/
219
220 =cut
221