Hello,

I think to make progress on this bug we really need a failing test case that
other people can reproduce.

I have hacked up small server that should reproduce the error (using fdWrite
instead of sendfile). And a small C client which is intended to reproduce
the error -- but doesn't.

I have attached both.

The server tries to write a whole lot of 'a' characters to the client. The
client does not consume any of them. This causes the server to block on the
threadWaitWrite.

No matter how I kill the client, threadWaitWrite always wakes up. So, we
need to figure out exactly what the PS3 is doing differently that causes
threadWaitWrite to not wakeup.. If we don't know why it is failing, then I
don't think we can properly fix it.

- jeremy
module Main where

import Control.Concurrent (forkIO)
import Control.Monad (forever)
import GHC.Conc		(threadWaitRead, threadWaitWrite)
import Network (PortID(PortNumber), Socket, listenOn, sClose)
import Network.Socket (accept, socketToHandle, send, fdSocket, setSocketOption, SocketOption(KeepAlive))
import System.IO
import System.Posix.IO
import System.Posix.Types
    
listen' :: PortID -> (Socket -> IO ()) -> IO ()     
listen' port handler =
  do socket <- listenOn port
     forever $ do (s,sa) <- accept socket
                  setSocketOption s KeepAlive 1
                  forkIO $ handler s
                  
main :: IO ()
main =
  listen' (PortNumber (toEnum 2525)) $ \s ->
    do -- h <- socketToHandle s ReadWriteMode
       let fd = Fd (fdSocket s)
       writeLoop fd (10^6)
      where 
        writeLoop :: Fd -> ByteCount -> IO ()
        writeLoop fd count | count <= 0 = 
          do putStrLn "done."
             return ()
        writeLoop fd count =
          do putStrLn "threadWaitWrite"
             threadWaitWrite fd
             putStrLn "writing..."
             n <- fdWrite fd $ take (fromIntegral count) (repeat 'a')
             putStrLn ("wrote: "  ++ show n)
             writeLoop fd (count - n)
          
       
  
#include <stdio.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netdb.h> 

void error(char *msg)
{
    perror(msg);
    exit(0);
}

int main(int argc, char *argv[])
{
    int sockfd, portno, n;
    struct sockaddr_in serv_addr;
    struct hostent *server;

    char buffer[256];
    if (argc < 3) {
       fprintf(stderr,"usage %s hostname port\n", argv[0]);
       exit(0);
    }
    portno = atoi(argv[2]);
    sockfd = socket(AF_INET, SOCK_STREAM, 0);
    if (sockfd < 0) 
        error("ERROR opening socket");
    server = gethostbyname(argv[1]);
    if (server == NULL) {
        fprintf(stderr,"ERROR, no such host\n");
        exit(0);
    }
    bzero((char *) &serv_addr, sizeof(serv_addr));
    serv_addr.sin_family = AF_INET;
    bcopy((char *)server->h_addr, 
         (char *)&serv_addr.sin_addr.s_addr,
         server->h_length);
    serv_addr.sin_port = htons(portno);
    if (connect(sockfd,&serv_addr,sizeof(serv_addr)) < 0) 
        error("ERROR connecting");
/*
    printf("Please enter the message: ");
    bzero(buffer,256);
    fgets(buffer,255,stdin);
    n = write(sockfd,buffer,strlen(buffer));
    if (n < 0) 
         error("ERROR writing to socket");
    bzero(buffer,256);

    n = read(sockfd,buffer,2);
    if (n < 0) 
         error("ERROR reading from socket");
    buffer[n] = '\0';
    printf("%s\n",buffer);
*/
    getchar();
    return 0;
}
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to