/[meteor]/googlecode.com/svn/trunk/Meteor/Socket.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /googlecode.com/svn/trunk/Meteor/Socket.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 48 - (show annotations)
Mon Feb 4 22:23:52 2008 UTC (16 years, 1 month ago) by knops.gerd
File size: 6544 byte(s)
• Added simple UDP broadcast abilities

1 #!/usr/bin/perl -w
2 ###############################################################################
3 # Meteor
4 # An HTTP server for the 2.0 web
5 # Copyright (c) 2006 contributing authors
6 #
7 # Subscriber.pm
8 #
9 # Description:
10 # Meteor socket additions
11 #
12 ###############################################################################
13 #
14 # This program is free software; you can redistribute it and/or modify it
15 # under the terms of the GNU General Public License as published by the Free
16 # Software Foundation; either version 2 of the License, or (at your option)
17 # any later version.
18 #
19 # This program is distributed in the hope that it will be useful, but WITHOUT
20 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
21 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
22 # more details.
23 #
24 # You should have received a copy of the GNU General Public License along
25 # with this program; if not, write to the Free Software Foundation, Inc.,
26 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27 #
28 # For more information visit www.meteorserver.org
29 #
30 ###############################################################################
31
32 package Meteor::Socket;
33 ###############################################################################
34 # Configuration
35 ###############################################################################
36
37 use strict;
38
39 use Socket;
40 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
41 use Errno qw(EINTR);
42
43 BEGIN {
44 $Meteor::Socket::handleNum=0;
45
46 # Cache getprotobyname result as on some systems it is slow.
47 $Meteor::Socket::TCP_PROTO_NAME=getprotobyname('tcp');
48 $Meteor::Socket::UDP_PROTO_NAME=getprotobyname('udp');
49 }
50
51 ###############################################################################
52 # Factory methods
53 ###############################################################################
54 sub new {
55 my $class=shift;
56
57 my $self=$class;
58
59 unless(ref($class))
60 {
61 $self={};
62 bless($self,$class);
63 }
64
65 $self->{'timeout'}=0;
66 $self->{'buffer'}='';
67
68 return $self;
69 }
70
71 sub newWithHandle {
72 my $class=shift;
73
74 my $self=$class->new;
75 $self->{'handle'}=shift;
76
77 my $vec='';
78 vec($vec,CORE::fileno($self->{'handle'}),1)=1;
79 $self->{'handleVec'}=$vec;
80
81 my $timeout=shift;
82 ($timeout) && ($self->{'timeout'}=$timeout);
83
84 return $self;
85 }
86
87 sub newServer {
88 my($class,$port,$queueSize,$srcIP)=@_;
89
90 ($port) || die("$class: port undefined!");
91
92 $queueSize||=5;
93
94 my $self=$class->new;
95
96 my $localAdr=INADDR_ANY;
97 $localAdr=inet_aton($srcIP) if(defined($srcIP) && $srcIP ne '');
98
99 my $local;
100 my $sockType=AF_INET;
101 my $proto=$Meteor::Socket::TCP_PROTO_NAME;
102
103 $self->{'port'}=$port;
104 ($local=sockaddr_in($port,$localAdr))
105 || die("$class: sockaddr_in for port '$port' failed");
106
107 $self->{'handle'}=$self->nextHandle();
108 $self->{'socketType'}=$sockType;
109
110 socket($self->{'handle'},$sockType,SOCK_STREAM,$proto)
111 || die("$class socket: $!");
112
113 setsockopt($self->{'handle'},SOL_SOCKET,SO_REUSEADDR,1);
114
115 bind($self->{'handle'},$local)
116 || die("$class bind: $!");
117 listen($self->{'handle'},$queueSize)
118 || die("$class listen: $!");
119
120 select((select($self->{'handle'}),$|=1)[0]);
121
122 my $vec='';
123 vec($vec,CORE::fileno($self->{'handle'}),1)=1;
124 $self->{'handleVec'}=$vec;
125
126 return $self;
127 }
128
129 sub newUDPServer {
130 my($class,$port,$srcIP)=@_;
131
132 ($port) || die("$class: port undefined!");
133
134 my $self=$class->new;
135
136 my $localAdr=INADDR_ANY;
137 $localAdr=inet_aton($srcIP) if(defined($srcIP) && $srcIP ne '');
138
139 my $local;
140 my $sockType=PF_INET;
141 my $proto=$Meteor::Socket::UDP_PROTO_NAME;
142
143 $self->{'port'}=$port;
144 ($local=sockaddr_in($port,$localAdr))
145 || die("$class: sockaddr_in for port '$port' failed");
146
147 $self->{'handle'}=$self->nextHandle();
148 $self->{'socketType'}=$sockType;
149
150 socket($self->{'handle'},$sockType,SOCK_DGRAM,$proto)
151 || die("$class socket: $!");
152
153 setsockopt($self->{'handle'},SOL_SOCKET,SO_REUSEADDR,pack("l", 1))
154 || die("setsockopt: $!");
155
156 bind($self->{'handle'},$local)
157 || die("$class bind: $!");
158
159 select((select($self->{'handle'}),$|=1)[0]);
160
161 my $vec='';
162 vec($vec,CORE::fileno($self->{'handle'}),1)=1;
163 $self->{'handleVec'}=$vec;
164
165 return $self;
166 }
167
168 ###############################################################################
169 # Instance methods
170 ###############################################################################
171 sub DESTROY {
172 my $self=shift;
173
174 if(exists($self->{'handle'}))
175 {
176 warn("$self->DESTROY caught unclosed socket")
177 unless($Meteor::Socket::NO_WARN_ON_CLOSE);
178 $self->close();
179 }
180 }
181
182 sub conSocket {
183 my $self=shift;
184
185 my $handle=$self->nextHandle();
186
187 my $paddr;
188 $paddr=&saccept($handle,$self->{'handle'}) || die($!);
189
190 select((select($handle),$|=1)[0]);
191
192 my $newSock=Meteor::Socket->newWithHandle($handle,20);
193 $newSock->{'socketType'}=$self->{'socketType'};
194 if($self->{'socketType'}==AF_INET)
195 {
196 my($port,$iaddr)=unpack_sockaddr_in($paddr);
197
198 $newSock->{'connection'}->{'port'}=$port;
199 $newSock->{'connection'}->{'remoteIP'}=inet_ntoa($iaddr);
200 }
201
202 return $newSock;
203 }
204
205 sub setNonBlocking {
206 my $self=shift;
207
208 my $flags=fcntl($self->{'handle'},F_GETFL,0)
209 or die("Can't get flags for the socket: $!");
210 fcntl($self->{'handle'},F_SETFL,$flags|O_NONBLOCK)
211 or die("Can't set flags for the socket: $!");
212 }
213
214 sub close {
215 my $self=shift;
216
217 if(exists($self->{'handle'}))
218 {
219 close($self->{'handle'});
220 delete($self->{'handle'});
221 }
222 }
223
224 ###############################################################################
225 # Utility functions
226 ###############################################################################
227 sub nextHandle {
228 no strict 'refs';
229
230 my $name='MSHandle'.$Meteor::Socket::handleNum++;
231 my $pack='Meteor::Socket::';
232 my $handle=\*{$pack.$name};
233 delete $$pack{$name};
234
235 $handle;
236 }
237
238 sub sselect {
239 my $result;
240 my $to=$_[3];
241 my $time=time;
242 while(1)
243 {
244 $result=CORE::select($_[0],$_[1],$_[2],$to);
245 if($result<0)
246 {
247 last unless(${!}==EINTR);
248 return 0 if($::HUP || $::TERM || $::USR1 || $::USR2);
249 my $tn=time;
250 $to-=($tn-$time);
251 $time=$tn;
252 $to=1 if($to<1);
253 }
254 else
255 {
256 last;
257 }
258 }
259
260 $result;
261 }
262
263 sub saccept {
264 my($dhandle,$shandle)=@_;
265
266 my $result;
267 while(1)
268 {
269 $result=CORE::accept($dhandle,$shandle);
270 unless($result)
271 {
272 last unless(${!}==EINTR);
273 return 0 if($::HUP || $::TERM || $::USR1 || $::USR2);
274 }
275 else
276 {
277 last;
278 }
279 }
280
281 $result;
282 }
283
284 sub fileno {
285 CORE::fileno(shift->{'handle'});
286 }
287
288 1;
289 ############################################################################EOF

  ViewVC Help
Powered by ViewVC 1.1.26