/[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 11 - (show annotations)
Thu Dec 14 16:29:42 2006 UTC (17 years, 3 months ago) by knops.gerd
File size: 5586 byte(s)
• Change CRLF line endings back to LF only

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 }
49
50 ###############################################################################
51 # Factory methods
52 ###############################################################################
53 sub new {
54 my $class=shift;
55
56 my $self=$class;
57
58 unless(ref($class))
59 {
60 $self={};
61 bless($self,$class);
62 }
63
64 $self->{'timeout'}=0;
65 $self->{'buffer'}='';
66
67 return $self;
68 }
69
70 sub newWithHandle {
71 my $class=shift;
72
73 my $self=$class->new;
74 $self->{'handle'}=shift;
75
76 my $vec='';
77 vec($vec,CORE::fileno($self->{'handle'}),1)=1;
78 $self->{'handleVec'}=$vec;
79
80 my $timeout=shift;
81 ($timeout) && ($self->{'timeout'}=$timeout);
82
83 return $self;
84 }
85
86 sub newServer {
87 my($class,$port,$queueSize,$srcIP)=@_;
88
89 ($port) || die("$class: port undefined!");
90
91 $queueSize||=5;
92
93 my $self=$class->new;
94
95 my $localAdr=INADDR_ANY;
96 $localAdr=inet_aton($srcIP) if(defined($srcIP) && $srcIP ne '');
97
98 my $local;
99 my $sockType=AF_INET;
100 my $proto=$Meteor::Socket::TCP_PROTO_NAME;
101
102 $self->{'port'}=$port;
103 ($local=sockaddr_in($port,$localAdr))
104 || die("$class: sockaddr_in for port '$port' failed");
105
106 $self->{'handle'}=$self->nextHandle();
107 $self->{'socketType'}=$sockType;
108
109 socket($self->{'handle'},$sockType,SOCK_STREAM,$proto)
110 || die("$class socket: $!");
111
112 setsockopt($self->{'handle'},SOL_SOCKET,SO_REUSEADDR,1);
113
114 bind($self->{'handle'},$local)
115 || die("$class bind: $!");
116 listen($self->{'handle'},$queueSize)
117 || die("$class listen: $!");
118
119 select((select($self->{'handle'}),$|=1)[0]);
120
121 my $vec='';
122 vec($vec,CORE::fileno($self->{'handle'}),1)=1;
123 $self->{'handleVec'}=$vec;
124
125 return $self;
126 }
127
128 ###############################################################################
129 # Instance methods
130 ###############################################################################
131 sub DESTROY {
132 my $self=shift;
133
134 if(exists($self->{'handle'}))
135 {
136 warn("$self->DESTROY caught unclosed socket")
137 unless($Meteor::Socket::NO_WARN_ON_CLOSE);
138 $self->close();
139 }
140 }
141
142 sub conSocket {
143 my $self=shift;
144
145 my $handle=$self->nextHandle();
146
147 my $paddr;
148 $paddr=&saccept($handle,$self->{'handle'}) || die($!);
149
150 select((select($handle),$|=1)[0]);
151
152 my $newSock=Meteor::Socket->newWithHandle($handle,20);
153 $newSock->{'socketType'}=$self->{'socketType'};
154 if($self->{'socketType'}==AF_INET)
155 {
156 my($port,$iaddr)=unpack_sockaddr_in($paddr);
157
158 $newSock->{'connection'}->{'port'}=$port;
159 $newSock->{'connection'}->{'remoteIP'}=inet_ntoa($iaddr);
160 }
161
162 return $newSock;
163 }
164
165 sub setNonBlocking {
166 my $self=shift;
167
168 my $flags=fcntl($self->{'handle'},F_GETFL,0)
169 or die("Can't get flags for the socket: $!");
170 fcntl($self->{'handle'},F_SETFL,$flags|O_NONBLOCK)
171 or die("Can't set flags for the socket: $!");
172 }
173
174 sub close {
175 my $self=shift;
176
177 if(exists($self->{'handle'}))
178 {
179 close($self->{'handle'});
180 delete($self->{'handle'});
181 }
182 }
183
184 ###############################################################################
185 # Utility functions
186 ###############################################################################
187 sub nextHandle {
188 no strict 'refs';
189
190 my $name='MSHandle'.$Meteor::Socket::handleNum++;
191 my $pack='Meteor::Socket::';
192 my $handle=\*{$pack.$name};
193 delete $$pack{$name};
194
195 $handle;
196 }
197
198 sub sselect {
199 my $result;
200 my $to=$_[3];
201 my $time=time;
202 while(1)
203 {
204 $result=CORE::select($_[0],$_[1],$_[2],$to);
205 if($result<0)
206 {
207 last unless(${!}==EINTR);
208 return 0 if($::HUP || $::TERM || $::USR1 || $::USR2);
209 my $tn=time;
210 $to-=($tn-$time);
211 $time=$tn;
212 $to=1 if($to<1);
213 }
214 else
215 {
216 last;
217 }
218 }
219
220 $result;
221 }
222
223 sub saccept {
224 my($dhandle,$shandle)=@_;
225
226 my $result;
227 while(1)
228 {
229 $result=CORE::accept($dhandle,$shandle);
230 unless($result)
231 {
232 last unless(${!}==EINTR);
233 return 0 if($::HUP || $::TERM || $::USR1 || $::USR2);
234 }
235 else
236 {
237 last;
238 }
239 }
240
241 $result;
242 }
243
244 sub fileno {
245 CORE::fileno(shift->{'handle'});
246 }
247
248 1;
249 ############################################################################EOF

  ViewVC Help
Powered by ViewVC 1.1.26