
Can anyone tell me why the following code doesn't work as expected? Both the server and client hang. If I run server 20000 & and client <hostname> 20000 the server logfile produces [dom@lhrtba8fd85 twotest]$ more log.txt Thu May 31 14:35:39 BST 2001 Starting logging Thu May 31 14:36:08 BST 2001 Hello world 48 65 6c 6c 6f 20 77 6f 72 6c 64 so it looks like the hPutStrLn to the socket never completes. On the client side, "Hello world" gets sent but the hGetLine never completes. Client do sh <- connectTo host port hPutStr sh "Hello world" hFlush sh x <- hGetLine sh putStrLn x Server socket <- listenOn port (sh,host,portid) <- accept socket let loop = do b <- getBuffer sh 16 case b of Full msg -> do logMessage ofh (hexedMessage msg) loop Partial msg -> do logMessage ofh (hexedMessage msg) hPutStrLn sh "Finishing Logging" hFlush sh logMessage ofh "Finishing logging" hClose ofh in loop Dominic. Here's the full code: module Main (main) where import System import IO import Time import Socket import Char main :: IO () main = do prog <- getProgName args <- getArgs if (length args /= 1) then do putStrLn ("Use: " ++ prog ++ " <port>") exitWith (ExitFailure (-1)) else return () let port = read (args !! 0) :: Int in server (PortNumber (mkPortNumber port)) -- The server function creates a socket to listen on the port and -- loops to log messages. server :: PortID -> IO () server port = do ofh <- openFile "log.txt" WriteMode logMessage ofh "Starting logging" socket <- listenOn port (sh,host,portid) <- accept socket let loop = do b <- getBuffer sh 16 case b of Full msg -> do logMessage ofh (hexedMessage msg) loop Partial msg -> do logMessage ofh (hexedMessage msg) hPutStrLn sh "Finishing Logging" hFlush sh logMessage ofh "Finishing logging" hClose ofh in loop data Buffer = Full String | Partial String getBuffer :: Handle -> Int -> IO Buffer getBuffer h n = if (n <= 0) then return (Full "") else do x <- try (hGetChar h) case x of Right c -> do xs <- getBuffer h (n-1) case xs of Full cs -> return (Full (c:cs)) Partial cs -> return (Partial (c:cs)) Left e -> if isEOFError e then return (Partial "") else ioError e logMessage :: Handle -> String -> IO () logMessage hd msg = do clock <- getClockTime calendar <- toCalendarTime clock hPutStrLn hd ((calendarTimeToString calendar) ++ "\n" ++ msg) hFlush hd showHex :: Char -> String showHex x = let y = ord x in hexDigit (y `div` 16):hexDigit (y `mod` 16):[] hexDigit :: Int -> Char hexDigit x | (0 <= x) && (x <= 9) = chr(ord '0' + x) | (10 <= x) && (x <=16) = chr(ord 'a' + (x-10)) | otherwise = error "Outside hexadecimal range" hexedMessage :: String -> String hexedMessage msg = (map toPrint msg) ++ " " ++ unwords (map showHex msg) toPrint :: Char -> Char toPrint x = if ((isAscii x) && (not (isControl x))) then x else '.' module Main(main) where import System import IO import Socket main :: IO () main = do prog <- getProgName args <- getArgs if (length args /= 2) then do putStrLn ("Use: " ++ prog ++ " <host> <port>") exitWith (ExitFailure (-1)) else return () let host = args !! 0 port = read (args !! 1) :: Int in client host (PortNumber (mkPortNumber port)) client :: Hostname -> PortID -> IO () client host port = do sh <- connectTo host port hPutStr sh "Hello world" hFlush sh x <- hGetLine sh putStrLn x ------------------------------------------------------------------------------------------------- 21st century air travel http://www.britishairways.com
participants (1)
-
Steinitz, Dominic J