/[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 3 - (hide annotations)
Mon Nov 20 17:59:30 2006 UTC (17 years, 4 months ago) by andrew.betts
File size: 5586 byte(s)
Initial import
1 andrew.betts 3 #!/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