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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 9 by andrew.betts, Fri Dec 8 16:52:58 2006 UTC revision 62 by andrew.betts, Thu Nov 27 00:33:21 2008 UTC
# Line 1  Line 1 
 #!/usr/bin/perl -w  
 ###############################################################################  
 #   Meteor  
 #   An HTTP server for the 2.0 web  
 #   Copyright (c) 2006 contributing authors  
 #  
 #   Subscriber.pm  
 #  
 #       Description:  
 #       Meteor socket additions  
 #  
 ###############################################################################  
 #  
 #   This program is free software; you can redistribute it and/or modify it  
 #   under the terms of the GNU General Public License as published by the Free  
 #   Software Foundation; either version 2 of the License, or (at your option)  
 #   any later version.  
 #  
 #   This program is distributed in the hope that it will be useful, but WITHOUT  
 #   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or  
 #   FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for  
 #   more details.  
 #  
 #   You should have received a copy of the GNU General Public License along  
 #   with this program; if not, write to the Free Software Foundation, Inc.,  
 #   59 Temple Place, Suite 330, Boston, MA 02111-1307 USA  
 #  
 #   For more information visit www.meteorserver.org  
 #  
 ###############################################################################  
   
 package Meteor::Socket;  
 ###############################################################################  
 # Configuration  
 ###############################################################################  
           
         use strict;  
           
         use Socket;  
         use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);  
         use Errno qw(EINTR);  
           
         BEGIN {  
                 $Meteor::Socket::handleNum=0;  
                   
                 # Cache getprotobyname result as on some systems it is slow.  
                 $Meteor::Socket::TCP_PROTO_NAME=getprotobyname('tcp');  
         }  
   
 ###############################################################################  
 # Factory methods  
 ###############################################################################  
 sub new {  
         my $class=shift;  
           
         my $self=$class;  
           
         unless(ref($class))  
         {  
                 $self={};  
                 bless($self,$class);  
         }  
           
         $self->{'timeout'}=0;  
         $self->{'buffer'}='';  
           
         return $self;  
 }  
   
 sub newWithHandle {  
         my $class=shift;  
           
         my $self=$class->new;  
         $self->{'handle'}=shift;  
           
         my $vec='';  
         vec($vec,CORE::fileno($self->{'handle'}),1)=1;  
         $self->{'handleVec'}=$vec;  
           
         my $timeout=shift;  
         ($timeout) && ($self->{'timeout'}=$timeout);  
           
         return $self;  
 }  
   
 sub newServer {  
         my($class,$port,$queueSize,$srcIP)=@_;  
           
         ($port) || die("$class: port undefined!");  
           
         $queueSize||=5;  
           
         my $self=$class->new;  
           
         my $localAdr=INADDR_ANY;  
         $localAdr=inet_aton($srcIP) if(defined($srcIP) && $srcIP ne '');  
           
         my $local;  
         my $sockType=AF_INET;  
         my $proto=$Meteor::Socket::TCP_PROTO_NAME;  
           
         $self->{'port'}=$port;  
         ($local=sockaddr_in($port,$localAdr))  
                 || die("$class: sockaddr_in for port '$port' failed");  
           
         $self->{'handle'}=$self->nextHandle();  
         $self->{'socketType'}=$sockType;  
           
         socket($self->{'handle'},$sockType,SOCK_STREAM,$proto)  
                 || die("$class socket: $!");  
           
         setsockopt($self->{'handle'},SOL_SOCKET,SO_REUSEADDR,1);  
           
         bind($self->{'handle'},$local)  
                 || die("$class bind: $!");  
         listen($self->{'handle'},$queueSize)  
                 || die("$class listen: $!");  
                   
         select((select($self->{'handle'}),$|=1)[0]);  
           
         my $vec='';  
         vec($vec,CORE::fileno($self->{'handle'}),1)=1;  
         $self->{'handleVec'}=$vec;  
           
         return $self;  
 }  
   
 ###############################################################################  
 # Instance methods  
 ###############################################################################  
 sub DESTROY {  
         my $self=shift;  
           
         if(exists($self->{'handle'}))  
         {  
                 warn("$self->DESTROY caught unclosed socket")  
                         unless($Meteor::Socket::NO_WARN_ON_CLOSE);  
                 $self->close();  
         }  
 }  
   
 sub conSocket {  
         my $self=shift;  
           
         my $handle=$self->nextHandle();  
           
         my $paddr;  
         $paddr=&saccept($handle,$self->{'handle'}) || die($!);  
           
         select((select($handle),$|=1)[0]);  
           
         my $newSock=Meteor::Socket->newWithHandle($handle,20);  
         $newSock->{'socketType'}=$self->{'socketType'};  
         if($self->{'socketType'}==AF_INET)  
         {  
                 my($port,$iaddr)=unpack_sockaddr_in($paddr);  
                   
                 $newSock->{'connection'}->{'port'}=$port;  
                 $newSock->{'connection'}->{'remoteIP'}=inet_ntoa($iaddr);  
         }  
           
         return $newSock;  
 }  
   
 sub setNonBlocking {  
         my $self=shift;  
           
         my $flags=fcntl($self->{'handle'},F_GETFL,0)  
                 or die("Can't get flags for the socket: $!");  
         fcntl($self->{'handle'},F_SETFL,$flags|O_NONBLOCK)  
                 or die("Can't set flags for the socket: $!");  
 }  
   
 sub close {  
         my $self=shift;  
           
         if(exists($self->{'handle'}))  
         {  
                 close($self->{'handle'});  
                 delete($self->{'handle'});  
         }  
 }  
   
 ###############################################################################  
 # Utility functions  
 ###############################################################################  
 sub nextHandle {  
         no strict 'refs';  
           
         my $name='MSHandle'.$Meteor::Socket::handleNum++;  
         my $pack='Meteor::Socket::';  
                 my $handle=\*{$pack.$name};  
         delete $$pack{$name};  
           
         $handle;  
 }        
   
 sub sselect {  
         my $result;  
         my $to=$_[3];  
         my $time=time;  
         while(1)  
         {  
                 $result=CORE::select($_[0],$_[1],$_[2],$to);  
                 if($result<0)  
                 {  
                         last unless(${!}==EINTR);  
                         return 0 if($::HUP || $::TERM || $::USR1 || $::USR2);  
                         my $tn=time;  
                         $to-=($tn-$time);  
                         $time=$tn;  
                         $to=1 if($to<1);  
                 }  
                 else  
                 {  
                         last;  
                 }  
         }  
           
         $result;  
 }  
   
 sub saccept {  
         my($dhandle,$shandle)=@_;  
           
         my $result;  
         while(1)  
         {  
                 $result=CORE::accept($dhandle,$shandle);  
                 unless($result)  
                 {  
                         last unless(${!}==EINTR);  
                         return 0 if($::HUP || $::TERM || $::USR1 || $::USR2);  
                 }  
                 else  
                 {  
                         last;  
                 }  
         }  
           
         $result;  
 }  
   
 sub fileno {  
         CORE::fileno(shift->{'handle'});  
 }  
   
 1;  
 ############################################################################EOF  
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
Legend:
Removed from v.9  
changed lines
  Added in v.62
  ViewVC Help
Powered by ViewVC 1.1.26