/[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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 48 - (hide 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 knops.gerd 11 #!/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 knops.gerd 48 $Meteor::Socket::UDP_PROTO_NAME=getprotobyname('udp');
49 knops.gerd 11 }
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 knops.gerd 48 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 knops.gerd 11 ###############################################################################
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 andrew.betts 3 ############################################################################EOF

  ViewVC Help
Powered by ViewVC 1.1.26