<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=us-ascii">
<META NAME="Generator" CONTENT="MS Exchange Server version 6.0.6603.0">
<TITLE>Perl Socket programming problem with Windows</TITLE>
</HEAD>
<BODY>
<!-- Converted from text/rtf format -->
<BR>
<P><FONT SIZE=2 FACE="Arial">Hello,</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial">I'm writing a TCP Server program that polls waits for socket connections on a specified port. The connection will be coming from a "black box" test harness written in C#.Net. The connection hand-shake design is as follow:</FONT></P>
<P><FONT SIZE=2 FACE="Arial">Black Box requests to connect to the Server</FONT>
<BR><FONT SIZE=2 FACE="Arial">Server responds back with a "Challenge" with a hardcode string "1001|1000"</FONT>
<BR><FONT SIZE=2 FACE="Arial">The Black Box reads the Challenge, then returns another request as "1001|1100"</FONT>
<BR><FONT SIZE=2 FACE="Arial">The Server will then processes the second request.</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial">On my Server end, I can start the server and wait for connections. When the Client makes a request to the Server, the Server accepts the connections, but I can't read the data being sent. When I attempt to read the data stream on the Server, it wait about 5 seconds, then the Client hangs. I'm using IO::Socket and IO::Select, and I've tried read, recv, <>, Open(filehandle), all attempts result with the same error.</FONT></P>
<P><FONT SIZE=2 FACE="Arial">Here's my Server code:</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial">use IO::Socket qw(:DEFAULT :crlf);</FONT>
<BR><FONT SIZE=2 FACE="Arial">#use IO::Socket;</FONT>
<BR><FONT SIZE=2 FACE="Arial">#use IO::Socket::INET;</FONT>
<BR><FONT SIZE=2 FACE="Arial">use IO::Handle;</FONT>
<BR><FONT SIZE=2 FACE="Arial">use IO::Select;</FONT>
<BR><FONT SIZE=2 FACE="Arial">use POSIX;</FONT>
<BR><FONT SIZE=2 FACE="Arial">use Socket;</FONT>
<BR><FONT SIZE=2 FACE="Arial">use Fcntl;</FONT>
<BR><FONT SIZE=2 FACE="Arial">use Tie::RefHash;</FONT>
<BR><FONT SIZE=2 FACE="Arial">use Net::Socket::NonBlock;</FONT>
<BR><FONT SIZE=2 FACE="Arial">local($/) = LF;</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial"># Setup global variables</FONT>
<BR><FONT SIZE=2 FACE="Arial">$ViewServer = "M:\\paul.krcma_csm_test\\PaulsTest\\release1";</FONT>
<BR><FONT SIZE=2 FACE="Arial">#$ServerName = 'EPWS3001';</FONT>
<BR><FONT SIZE=2 FACE="Arial">$ServerName = 'RCSLMN10L3CNMW6';</FONT>
<BR><FONT SIZE=2 FACE="Arial">$port_num = '8003';</FONT>
<BR><FONT SIZE=2 FACE="Arial">$ReqId = "1000";</FONT>
<BR><FONT SIZE=2 FACE="Arial">$client = "";</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial"># Create socket object</FONT>
<BR><FONT SIZE=2 FACE="Arial">$server = IO::Socket::INET->new('LocalPort' => $port_num,</FONT>
<BR> <FONT SIZE=2 FACE="Arial"> 'Proto' => 'tcp',</FONT>
<BR> <FONT SIZE=2 FACE="Arial"> 'Type' => SOCK_STREAM,</FONT>
<BR> <FONT SIZE=2 FACE="Arial"> 'Block' => 0,</FONT>
<BR> <FONT SIZE=2 FACE="Arial"> 'Listen' => 16,</FONT>
<BR><FONT SIZE=2 FACE="Arial"> 'Reuse' => 1)</FONT>
<BR><FONT SIZE=2 FACE="Arial"> or die "Can't create socket ($!)\n";</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial">%inbuffer = ();</FONT>
<BR><FONT SIZE=2 FACE="Arial">%outbuffer = ();</FONT>
<BR><FONT SIZE=2 FACE="Arial">%ready = ();</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial">tie %ready, 'Tie::RefHash';</FONT>
<BR><FONT SIZE=2 FACE="Arial">#nonblock($server);</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial"> # Create a new IO::Socket Object</FONT>
<BR><FONT SIZE=2 FACE="Arial">$select = IO::Select->new;</FONT>
<BR><FONT SIZE=2 FACE="Arial">$select->add($server);</FONT>
<BR><FONT SIZE=2 FACE="Arial">#my $select->add($socket); # Add a Listener to the IO::Socket object</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial">print "Server listening\n";</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial"># Wait for incoming requests, and open new sockets when needed</FONT>
<BR><FONT SIZE=2 FACE="Arial">while (1) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $client;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $rv;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $data;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $sn;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> foreach $client ($select->can_read()) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Creating TCPSocketListener\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Checking for client = server\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> if($client == $server) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #my $new;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # Level 1 If</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # Create a new socket and add the handles to the Select object</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $client = $server->accept();</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $select->add($client);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $client->autoflush(1);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $client->blocking(false);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $ClientName = gethostbyaddr($client->peeraddr, AF_INET);</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial"> #print "data is $rv{$client}\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print "New Socket opened\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print "Generating RequestId and sending Challenge to back to Core\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $buffer = '';</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $rv = recv($client, $buffer, 1024,0); ########### This line causes the Client to hang ######################</FONT></P>
<P><FONT SIZE=2 FACE="Arial"> &Generate_ReqId($ReqId);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print "Req ID = $ReqId\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Reading data\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #$sn = $client->send($ReqId);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #while(<$client>) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # chop $_;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # $data = $_;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #}</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Data received is $data\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #$SendPack = $ReqId."|1000\015\012";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #$sn = $client->send($SendPack);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #$client "$ReqId|1000";</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial"> #print "Inside level 1 if\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print "Authorizing user\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print $new "$ReqId|0|";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Leaving the client-server loop\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> else {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # Fork the incoming connection from the parent</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "A separate connection\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Packet is $packet\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #&process_connection;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $data = '';</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $rv = $client->recv($data, POSIX::BUFSIZ, 0);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> unless (defined($rv) && length $data) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # Client disconnected so do some cleanup</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Going to delete the buffers\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print $client "OK";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> delete $inbuffer{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> delete $outbuffer{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> delete $ready{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $select->remove($client);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> close $client;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> next;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $inbuffer{$client} .= $data;</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial"> #print " Existing Connection\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print "Received Authentication string from Core\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print $rv{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print "Sending Authentication approval back to Core\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print $client "$ReqId|0|";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #&process_connection;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> while ($inbuffer{$client} =~ s/(.*\n)//) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "building array of requests\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> push( @{$ready{$client}}, $1 );</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Outside If\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # Any complete requests to process ?</FONT>
<BR><FONT SIZE=2 FACE="Arial"> foreach $client (keys %ready) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Handling a request\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> handle($client);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial"> # Buffers to flush ?</FONT>
<BR><FONT SIZE=2 FACE="Arial"> foreach $client ($select->can_write(1)) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Flushing the buffers\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #next unless exists $outbuffer{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Sending information to the outbuffer\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $rv = $client->send($outbuffer{$client}, 0);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> unless (defined $rv) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> warn "I can't write\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> next;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Reading the length of the outbuffer\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> if ($rv == length $outbuffer{$client} ||</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $! == POSIX::EWOULDBLOCK) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Doing some stuff with the outbuffer\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> substr($outbuffer{$client}, 0 , $rv) = '';</FONT>
<BR><FONT SIZE=2 FACE="Arial"> delete $outbuffer{$client} unless length $outbuffer{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> else {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Cleaning up the flush buffers\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> delete $inbuffer{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> delete $outbuffer{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> delete $read{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> select->remove($client);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> close($client);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> next;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Leaving Flush Buffers\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #$select->remove($client); </FONT>
<BR><FONT SIZE=2 FACE="Arial"> #close $client; </FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Leaving the Listener\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #close $client or die "Can't close ($!)\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial">} die "Can't accept socket ($!)\n";</FONT>
</P>
<BR>
<P><FONT SIZE=2 FACE="Arial">sub Generate_ReqId($Rid) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $ReqId++;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> return $ReqId;</FONT>
<BR><FONT SIZE=2 FACE="Arial">}</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial">sub handle {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> my $client = shift;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Inside the Handle sub $client\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> my $request;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> foreach $request (@{$ready{$client}}) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Inside the request for loop $request\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # put the text of reply into the $outbuffer{$client}</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $outbuffer{$client} .= $request;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $packet = $outbuffer{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Packet is $outbuffer{$client}\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial"> delete $ready{$client};</FONT>
<BR><FONT SIZE=2 FACE="Arial">}</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial">sub process_connection {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Inside process_connection\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print $client "$.: $_";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $CoreReqId = "";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $ReqType = "";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $CNNum = "";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $ProjId = "";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $CdPack = "";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $CdPackLoc = "";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #my $ClientName = gethostbyaddr($socket->peeraddr, AF_INET);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #my $port = $socket->peerport;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print "[$ClientName $port]\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # Once a client has been accepted, print out the client information and the packet it sent</FONT>
<BR><FONT SIZE=2 FACE="Arial"> while (<$client>) {</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $packetname = $_;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "Packet is $_\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print "[$ClientName $port] $_";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print $client "$.: $_";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # Parse the packet</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # NOTE: Don't chop the packet. The return character needs to remain imbedded in</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # the packet to return back to the client</FONT>
<BR><FONT SIZE=2 FACE="Arial"> ($CoreRegId,$ReqType,$CNNum,$ProjId,$CdPack,$CdPackLoc) = split(/\|/,$packetname);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> print "$CoreReqId, $ReqType $CNNum $ProjId $CdPack $CdPackLoc\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> # Chop the last entry of the split string and join the CdPackLoc with CdPack</FONT>
<BR><FONT SIZE=2 FACE="Arial"> chop $CdPackLoc;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $NewElement = $CdPackLoc.$CdPack;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #$EndTime = `echo %time%`;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> #print "End Time = $EndTime\n";</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $select->remove($client);</FONT>
<BR><FONT SIZE=2 FACE="Arial"> $client->close;</FONT>
<BR><FONT SIZE=2 FACE="Arial"> }</FONT>
<BR><FONT SIZE=2 FACE="Arial">}</FONT>
</P>
<P><FONT SIZE=2 FACE="Arial">The programmer for the Black Box side assures me that he is not putting any special end-of-line characters in his output string. I'm at a total loss for what is going on here. Any help would be appreciated.</FONT></P>
<P><FONT SIZE=2 FACE="Arial">Thanks,</FONT>
</P>
<P><FONT SIZE=2 FACE="Courier">Paul Krcma</FONT>
<BR><FONT SIZE=2 FACE="Courier">CMI Client/Server (EISS)</FONT>
<BR><FONT SIZE=2 FACE="Courier">612-316-3712</FONT>
</P>
</BODY>
</HTML>