[Kc] demonstration of multiple listening with select(2)

Todd Harris harris at cshl.org
Mon Jan 26 09:29:04 CST 2004


You might check out Lincoln Stein's 'Network Programming with Perl'.  It's
filled with all sorts of goodness related to tasks like this.

todd


> On 1/25/04 10:51 PM, david nicol wrote:

> 
> Some days ago I asked kclug if anyone had any examples of
> tcp socket code that listens on multiple ports with select.  Nobody
> wrote back on that issue, but I did some research and experimenting:
> The attached program opens up ports 8021 and 8022 on your machine
> and runs a basicly useless service on them both. It handles disconnects
> gracefully and will close a connection that issues /quit/.
> 
> Enjoy
> 
> To make a useful singlethreaded server, you essentially need to
> extend the @Something2Say array from MultipleListen into an array
> of state objects, still indexed by file descriptor number.  The length
> constraints on the syswrite and sysread commands are far far too short,
> also -- they are so short to demonstrate that reading and writing over
> multiple passes works: when I extend this into an all-in-one e-mail
> toaster, the read length will be around 8K, and the write length will be
> the length of what is to be written, so the networking layer will take
> as much as it can.
> 
> 
> I do not know what kinds of situations trigger appearances on the
> exception queue. I had thought that connections to listening sockets
> would do that, but they appear as read-readiness.  Perhaps sending OOB
> data?
> 
> David Nicol
> 
> 
> 
> 
> 
> 
> use Socket;
> 
> my $proto = getprotobyname('tcp');
> 
> 
> socket(Server1, PF_INET, SOCK_STREAM, $proto);
> socket(Server2, PF_INET, SOCK_STREAM, $proto);
> 
> setsockopt(Server1, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))   || die
> "setsockopt: $!";
>     bind(Server1, sockaddr_in(8021, INADDR_ANY))        || die "bind: $!";
>   listen(Server1,SOMAXCONN)                            || die "listen: $!";
> 
> 
> setsockopt(Server2, SOL_SOCKET, SO_REUSEADDR,  pack("l", 1))   || die
> "setsockopt: $!";
>     bind(Server2, sockaddr_in(8022, INADDR_ANY))        || die "bind: $!";
>   listen(Server2,SOMAXCONN)                            || die "listen: $!";
> 
> print "listenintg on 8021 and 8022\n";
> 
> my $rin = $win = $ein = '';
> 
> vec($rin,fileno(Server1),1) = 1;
> vec($rin,fileno(Server2),1) = 1;
> 
> vec($win,fileno(Server1),1) = 1;
> vec($win,fileno(Server2),1) = 1;
> 
> vec($ein,fileno(Server1),1) = 1;
> vec($ein,fileno(Server2),1) = 1;
> 
> # for (;;){
> 
> while ( $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef) ) {
> $count++;
> 
> print "found $nfound\n";
> $nfound < 1 and die "$!\n";
> 
> if(vec($rout,fileno(Server1),1)){
> print "Server1 in rout\n";
> accept(my $NewServer1, Server1) or print "1:accept error: $!\n";
> print "new server1 on ",fileno($NewServer1 ),"\n";
> push @Server1socks,$NewServer1;
> $Something2Say[fileno($NewServer1 )] = '';
> 
> };
> if(vec($rout,fileno(Server2),1)){
> print "Server2 in rout\n";
> accept(my $NewServer2, Server2) or print "2:accept error: $!\n";
> print "new server2 on ",fileno($NewServer2 ),"\n";
> push @Server2socks,$NewServer2;
> $Something2Say[fileno($NewServer2 )] = '';
> };
> 
> if(vec($wout,fileno(Server1),1)){
> print "Server1 in wout\n";
> };
> if(vec($wout,fileno(Server2),1)){
> print "Server2 in wout\n";
> };
> 
> if(vec($eout,fileno(Server1),1)){
> print "Server1 in eout\n";
> };
> if(vec($eout,fileno(Server2),1)){
> print "Server2 in eout\n";
> };
> 
> foreach (@Server1socks, @Server2socks){
> 
> if(vec($rout,fileno($_),1)){
> my $char;
> sysread $_,$char,10;
> if(length $char){
> print "socket $_ in rout: read ten bits and got [$char]\n";
> $char =~ /quit/ and goto CLOSEME;
> $char = uc $char;
> $char =~ s/\W//g;
> $Something2Say[fileno($_)] .= "you said '$char'\n";
> }else{
> print "Received empty packet on $_ (",fileno($_),
> ") $!\n";
> CLOSEME:
> my $me = fileno($_);
> close $_;
> print "CLOSING and FORGETTING ABOUT fd $me\n";
> {
>  local $_;
>  # @Server1socks = map { fileno($_) != $me } @Server1socks;
>  # @Server2socks = map { fileno($_) != $me } @Server2socks;
>  @Server2socks = grep { fileno($_) } @Server2socks;
>  @Server1socks = grep { fileno($_) } @Server1socks;
> };
> next;    # enough with this closed socket
> };
> };
> if(vec($wout,fileno($_),1)){
> if(length($Something2Say[fileno($_)])){
> # print "socket $_ in wout\n";
> my $readlen = syswrite $_, $Something2Say[fileno($_)], 4;
> defined $readlen or print "Error on socket $_: $!";
> substr $Something2Say[fileno($_)], 0, $readlen, '';
> # print $_ "$count: $_\n";
> };
> };
> if(vec($eout,fileno($_),1)){
> print "EXCEPTION socket $_ in eout\n";
> };
> 
> };
> 
> $rin = '';
> vec($rin,fileno(Server1),1) = 1;
> vec($rin,fileno(Server2),1) = 1;
> vec($rin,500,1) = 0;
> $ein = $win = $rin ;
> 
> foreach (@Server1socks, @Server2socks){
> vec($rin,fileno($_),1) = 1;
> length($Something2Say[fileno($_)]) and vec($win,fileno($_),1) = 1;
> vec($ein,fileno($_),1) = 1;
> };
> };
> 
> 
> 
> _______________________________________________
> kc mailing list
> kc at mail.pm.org
> http://mail.pm.org/mailman/listinfo/kc
> 




More information about the kc mailing list