From 5e8efa7bbca93fdf7a2b8a541181aa2aefe590db Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Tue, 18 Jun 2013 23:18:48 +0000 Subject: [PATCH] Adapt to changes in 'GHC.Handle'. * src/TorDNSEL/ExitTest/Request.hs (getRequest): Use 'hGetLineN' instead of 'hGetLine'. * src/TorDNSEL/TorControl/Internals.hs (startSocketReader): Likewise. * src/TorDNSEL/Util.hsc (hGetLine): Replace with 'hGetLineN'. --- src/TorDNSEL/ExitTest/Request.hs | 14 ++-- src/TorDNSEL/TorControl/Internals.hs | 5 +- src/TorDNSEL/Util.hsc | 125 +++------------------------------- 3 files changed, 20 insertions(+), 124 deletions(-) diff --git a/src/TorDNSEL/ExitTest/Request.hs b/src/TorDNSEL/ExitTest/Request.hs index 87a2fbd..05e2f46 100644 --- a/src/TorDNSEL/ExitTest/Request.hs +++ b/src/TorDNSEL/ExitTest/Request.hs @@ -73,19 +73,19 @@ getRequest client = do crlfLen = 2 getHeader = do - reqLine <- hGetLine client crlf maxHeaderLen + reqLine <- hGetLineN client crlf maxHeaderLen headers <- getHeaders (maxHeaderLen - B.length reqLine - crlfLen) return (reqLine, M.fromList headers) getHeaders remain | remain <= 0 = return [] | otherwise = do - header <- hGetLine client crlf remain - if B.null header - then return [] - else do - headers <- getHeaders (remain - B.length header - crlfLen) - return (readHeader header : headers) + header <- hGetLineN client crlf remain + if B.null header + then return [] + else do + headers <- getHeaders (remain - B.length header - crlfLen) + return (readHeader header : headers) readHeader = (B.map toLower *** B.dropWhile isSpace . B.drop 1) . B.break (== ':') diff --git a/src/TorDNSEL/TorControl/Internals.hs b/src/TorDNSEL/TorControl/Internals.hs index 015bd76..e9e4c1a 100644 --- a/src/TorDNSEL/TorControl/Internals.hs +++ b/src/TorDNSEL/TorControl/Internals.hs @@ -847,7 +847,7 @@ startSocketReader handle sendRepliesToIOManager = forkLinkIO . forever $ readReplies >>= sendRepliesToIOManager where readReplies = do - line <- parseReplyLine =<< hGetLine handle crlf maxLineLength + line <- parseReplyLine =<< hGetLineN handle (B.pack "\r\n") maxLineLength case line of MidReply reply -> fmap (reply :) readReplies LastReply reply -> return [reply] @@ -865,13 +865,12 @@ startSocketReader handle sendRepliesToIOManager = cat "Malformed reply line type " (esc 1 typ) '.' readData = do - line <- hGetLine handle (B.pack "\n") maxLineLength + line <- hGetLineN handle (B.pack "\n") maxLineLength case (if B.last line == '\r' then B.init else id) line of line' | line == (B.pack ".\r") -> return [] | any B.null [line, line'] -> readData | otherwise -> fmap (line' :) readData - crlf = B.pack "\r\n" maxLineLength = 2^20 -------------------------------------------------------------------------------- diff --git a/src/TorDNSEL/Util.hsc b/src/TorDNSEL/Util.hsc index bb81b43..92c7ca3 100644 --- a/src/TorDNSEL/Util.hsc +++ b/src/TorDNSEL/Util.hsc @@ -58,7 +58,7 @@ module TorDNSEL.Util ( , inBoundsOf , htonl , ntohl - , hGetLine + , hGetLineN , splitByDelimiter , showException , showUTCTime @@ -132,17 +132,14 @@ import Network.Socket import System.Directory (doesFileExist, removeFile) import System.Environment (getProgName) import System.Exit (exitWith, ExitCode) -import System.IO (hPutStr) +import System.IO (hPutStr, hSetBuffering) import System.IO.Error (isEOFError) import System.Posix.Files (setFileMode) import System.Posix.Types (FileMode) import Text.Printf (printf) -import GHC.Handle - (wantReadableHandle, fillReadBuffer, readCharFromBuffer, ioe_EOF) -import GHC.IOBase - ( Handle, Handle__(..), Buffer(..), readIORef, writeIORef - , BufferMode(NoBuffering) ) +import GHC.IO.Handle (BufferMode(..)) +import GHC.IOBase (Handle, Handle__(..), readIORef, writeIORef) import Data.Binary (Binary(..)) @@ -368,113 +365,13 @@ instance Error e => MonadError e Maybe where foreign import ccall unsafe "htonl" htonl :: Word32 -> Word32 foreign import ccall unsafe "ntohl" ntohl :: Word32 -> Word32 --- | Read a line terminated by an arbitrary sequence of bytes from a handle. The --- end-of-line sequence is stripped before returning the line. @maxLen@ --- specifies the maximum line length to read, not including the end-of-line --- sequence. If the line length exceeds @maxLen@, return the first @maxLen@ --- bytes. If EOF is encountered, return the bytes preceding it. The handle --- should be in 'LineBuffering' mode. -hGetLine :: Handle -> ByteString -> Int -> IO ByteString -hGetLine h eol maxLen | B.null eol = B.hGet h maxLen -hGetLine h eol@(B.PS _ _ eolLen) maxLen - = wantReadableHandle "TorDNSEL.Util.hGetLine" h $ \handle_ -> do - case haBufferMode handle_ of - NoBuffering -> error "no buffering" - _other -> hGetLineBuffered handle_ - - where - hGetLineBuffered handle_ = do - let ref = haBuffer handle_ - buf <- readIORef ref - hGetLineBufferedLoop handle_ ref buf 0 0 [] - - hGetLineBufferedLoop handle_ ref - buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } !len !eolIx xss = do - (new_eolIx,off) <- findEOL eolIx r w raw - let new_len = len + off - r - - if maxLen > 0 && new_len - new_eolIx > maxLen - -- If the line length exceeds maxLen, return a partial line. - then do - let maxOff = off - (new_len - maxLen) - writeIORef ref buf{ bufRPtr = maxOff } - mkBigPS . (:xss) =<< mkPS raw r maxOff - else if new_eolIx == eolLen - -- We have a complete line; strip the EOL sequence and return it. - then do - if w == off - then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } - else writeIORef ref buf{ bufRPtr = off } - if eolLen <= off - r - then mkBigPS . (:xss) =<< mkPS raw r (off - eolLen) - else fmap stripEOL . mkBigPS . (:xss) =<< mkPS raw r off - else do - xs <- mkPS raw r off - maybe_buf <- maybeFillReadBuffer (haFD handle_) True - (haIsStream handle_) buf{ bufWPtr=0, bufRPtr=0 } - case maybe_buf of - -- Nothing indicates we caught an EOF, and we may have a - -- partial line to return. - Nothing -> do - writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } - if new_len > 0 - then mkBigPS (xs:xss) - else ioe_EOF - Just new_buf -> - hGetLineBufferedLoop handle_ ref new_buf new_len new_eolIx - (xs:xss) - - maybeFillReadBuffer fd is_line is_stream buf - = catch (Just `fmap` fillReadBuffer fd is_line is_stream buf) - (\e -> if isEOFError e then return Nothing else ioError e) - - findEOL eolIx - | eolLen == 1 = findEOLChar (B.w2c $ B.unsafeHead eol) - | otherwise = findEOLSeq eolIx - - findEOLChar eolChar r w raw - | r == w = return (0, r) - | otherwise = do - (!c,!r') <- readCharFromBuffer raw r - if c == eolChar - then return (1, r') - else findEOLChar eolChar r' w raw - - -- find the end-of-line sequence, if there is one - findEOLSeq !eolIx r w raw - | eolIx == eolLen || r == w = return (eolIx, r) - | otherwise = do - (!c,!r') <- readCharFromBuffer raw r - findEOLSeq (next c eolIx + 1) r' w raw - - -- get the next index into the EOL sequence we should match against - next !c !i = if i >= 0 && c /= eolIndex i then next c (table ! i) else i - - eolIndex = B.w2c . B.unsafeIndex eol - - -- build a match table for the Knuth-Morris-Pratt algorithm - table = runSTUArray (do - arr <- newArray_ (0, if eolLen == 1 then 1 else eolLen - 1) - zipWithM_ (writeArray arr) [0,1] [-1,0] - loop arr 2 0) - where - loop arr !t !p - | t >= eolLen = return arr - | eolIndex (t - 1) == eolIndex p - = let p' = p + 1 in writeArray arr t p' >> loop arr (t + 1) p' - | p > 0 = readArray arr p >>= loop arr t - | otherwise = writeArray arr t 0 >> loop arr (t + 1) p - - stripEOL (B.PS p s l) = E.assert (new_len >= 0) . B.copy $ B.PS p s new_len - where new_len = l - eolLen - - mkPS buf start end = B.create len $ \p -> do - B.memcpy_ptr_baoff p buf (fromIntegral start) (fromIntegral len) - return () - where len = end - start - - mkBigPS [ps] = return ps - mkBigPS pss = return $! B.concat (reverse pss) +-- | Read @n@ bytes from @handle@; strip @eol@ (e.g., @'B.pack' "\r\n"@) +-- and everything after it. +hGetLineN :: Handle -> ByteString -> Int -> IO ByteString +hGetLineN handle eol n = do + hSetBuffering handle LineBuffering + bStr <- B.hGet handle n + return $ fst $ B.breakSubstring eol bStr -- | Split @bs@ into pieces delimited by @delimiter@, consuming the delimiter. -- The result for overlapping delimiters is undefined. -- 1.7.5.4