Is it possible that STDOUT is closed?
If STDOUT is closed, fileno(SERVER) might end up being '1', and then,
printing to STDOUT would go to a socket that doesn't accept write().
What does:
print STDERR "fileno of server = ", fileno(SERVER), "\n";
Print out?
Also, try to see why the print fails. Change any:
print "We don't see this?\n";
To:
print "We don't see this?\n"
or print STDERR "print failed: $!\n";
This may tell us what is going on.
Cheers,
mark
On Wed, Aug 16, 2006 at 10:09:27AM -0700, Barry Brevik wrote:
> >If Barry could provide a small, self contained script
> >that demonstrates the problem it might be a lot easier to see.
>
> Brian makes a good point (because flushing STDOUT did not work, but I enjoyed
> learning about it). I wanted to avoid wasting bandwidth with a snippet,
> because the snippet is rather large.
>
> To set this up, I'm posting the portion of a loop that listens on port 80,
> then forks a process to handle that connection. I post this because it may be
> relevant. P.S. there is a bunch of socket setup code that is missing, but
> this is a really common method that I used almost verbatim out of a book.
>
> The problem occurs in the subroutine (below) named client_chat. Any "print"
> statements in that routine must go to STDERR or they are not seen until *main
> process* (not child) terminates. Please be gentle; I'm rather new to Perl so
> the code may be amateurish, but I just love the language.
>
> $nfound = select($sout = $sin, undef, undef, .25);
> if (vec($sout, fileno(SERVER), 1))
> {
> $client_addr = accept(CLIENT, SERVER);
> ($client_socket, $client_pip) = sockaddr_in($client_addr);
> if ($client_pip)
> {
> $client_ip = inet_ntoa($client_pip);
>
> if ($client_pip)
> {
> unless (defined($kidpid = fork()))
> {
> print "failed to fork after client connect: $!";
> next;
> }
>
> if ($kidpid)
> {
> # If we were forking successful, just 'fire and forget'.
> $SIG{$kidpid} = 'IGNORE';
> close(CLIENT);
> }
> else
> {
> close(SERVER);
>
> client_chat();
>
> close(CLIENT);
> exit;
> }
> }
> }
> }
>
>
> sub client_chat
> {
> # Set up bitmask for client.
> $cin = ''; vec($cin, fileno(CLIENT), 1) = 1;
>
> # Check to see if data is ready, and if so, read it.
> # Do this until the timeout is reached, or we see two
> # CRLF's in a row.
> $loopstart = time(); $bufend = 0;
> $bufr = ''; @bufr = (); $useragent = '';
>
> for (;;)
> {
> $nfound = select($cout = $cin, undef, undef, .01);
> if (vec($cout, fileno(CLIENT), 1))
> {
> $rec = recv(CLIENT, $dread, 8192, 0);
> $dread =~ s/\x0+//g;
> $bufr .= $dread;
> if ($bufr =~ /\r\n\r\n$/m) {$bufend = 1; last;}
> $loopstart = time();
> }
>
> if (time() - $loopstart >= $ctimeout)
> {
> print STDERR "timeout reached while waiting for client input";
> last;
> }
> }
> _______________________________________________
> ActivePerl mailing list
> [email protected]
> To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
--
[EMAIL PROTECTED] / [EMAIL PROTECTED] / [EMAIL PROTECTED]
__________________________
. . _ ._ . . .__ . . ._. .__ . . . .__ | Neighbourhood Coder
|\/| |_| |_| |/ |_ |\/| | |_ | |/ |_ |
| | | | | \ | \ |__ . | | .|. |__ |__ | \ |__ | Ottawa, Ontario, Canada
One ring to rule them all, one ring to find them, one ring to bring them all
and in the darkness bind them...
http://mark.mielke.cc/
_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
