[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]

[tor-commits] [tordnsel/master] fix a space leak when reading tor control messages



commit 5a70559f8ca976e51d830f6fafb12b045f577055
Author: David Kaloper <david@xxxxxxxx>
Date:   Tue Oct 29 04:43:52 2013 +0100

    fix a space leak when reading tor control messages
    
    Data.Conduit.leftover considered harmful.
---
 src/TorDNSEL/ExitTest/Request.hs     |  7 ++--
 src/TorDNSEL/TorControl/Internals.hs |  5 +--
 src/TorDNSEL/Util.hsc                | 76 +++++++++++++++++++++---------------
 3 files changed, 49 insertions(+), 39 deletions(-)

diff --git a/src/TorDNSEL/ExitTest/Request.hs b/src/TorDNSEL/ExitTest/Request.hs
index 84f502a..affa6b8 100644
--- a/src/TorDNSEL/ExitTest/Request.hs
+++ b/src/TorDNSEL/ExitTest/Request.hs
@@ -68,17 +68,16 @@ createRequest host port cookie =
 getRequest :: Handle -> IO (Maybe Cookie)
 getRequest client =
     CB.sourceHandle client $= CB.isolate maxReqLen $$ do
-      reqline <- line
+      reqline <- c_line_crlf
       hs      <- accHeaders []
       case checkHeaders reqline hs of
            Nothing -> return Nothing
-           Just _  -> Just . Cookie <$> takeC cookieLen
+           Just _  -> Just . Cookie <$> c_take cookieLen
 
   where
     maxReqLen = 2048 + cookieLen
-    line      = fromMaybe "" <$> frame "\r\n"
 
-    accHeaders hs = line >>= \ln ->
+    accHeaders hs = c_line_crlf >>= \ln -> do
       if ln == "" then return $ M.fromList hs
                   else accHeaders (parseHeader ln : hs)
 
diff --git a/src/TorDNSEL/TorControl/Internals.hs b/src/TorDNSEL/TorControl/Internals.hs
index 0d299d6..43b6d19 100644
--- a/src/TorDNSEL/TorControl/Internals.hs
+++ b/src/TorDNSEL/TorControl/Internals.hs
@@ -834,8 +834,7 @@ startSocketReader handle sendRepliesToIOManager =
 
 -- | Stream decoded 'Reply' groups.
 c_replies :: Conduit B.ByteString IO [Reply]
-c_replies =
-    frames (B.pack "\r\n") =$= line0 []
+c_replies = c_lines_any =$= line0 []
   where
 
     line0 acc = await >>= return () `maybe` \line -> do
@@ -855,7 +854,7 @@ c_replies =
       await >>= \mline -> case mline of
           Nothing                        -> return $ reverse acc
           Just line | B.null line        -> rest acc
-                    | line == B.pack "." -> return $ reverse (line:acc)
+                    | line == B.pack "." -> return $ reverse acc
                     | otherwise          -> rest (line:acc)
 
 --------------------------------------------------------------------------------
diff --git a/src/TorDNSEL/Util.hsc b/src/TorDNSEL/Util.hsc
index 2c57e0e..7397208 100644
--- a/src/TorDNSEL/Util.hsc
+++ b/src/TorDNSEL/Util.hsc
@@ -64,9 +64,10 @@ module TorDNSEL.Util (
   , showUTCTime
 
   -- * Conduit utilities
-  , takeC
-  , frames
-  , frame
+  , c_take
+  , c_breakDelim
+  , c_line_crlf
+  , c_lines_any
 
   -- * Network functions
   , bindUDPSocket
@@ -141,6 +142,7 @@ import Text.Printf (printf)
 import Data.Binary (Binary(..))
 
 import qualified Data.Conduit as C
+import qualified Data.Conduit.List as CL
 import qualified Data.Conduit.Binary as CB
 
 #include <netinet/in.h>
@@ -414,49 +416,59 @@ instance Error e => MonadError e Maybe where
 foreign import ccall unsafe "htonl" htonl :: Word32 -> Word32
 foreign import ccall unsafe "ntohl" ntohl :: Word32 -> Word32
 
-takeC :: Monad m => Int -> C.ConduitM ByteString o m ByteString
-takeC = fmap (mconcat . BL.toChunks) . CB.take
+-- | Convert a 'UTCTime' to a string in ISO 8601 format.
+showUTCTime :: UTCTime -> String
+showUTCTime time = printf "%s %02d:%02d:%s" date hours mins secStr'
+  where
+    date = show (utctDay time)
+    (n,d) = (numerator &&& denominator) (toRational $ utctDayTime time)
+    (seconds,frac) = n `divMod` d
+    (hours,(mins,sec)) = second (`divMod` 60) (seconds `divMod` (60^2))
+    secs = fromRational (frac % d) + fromIntegral sec
+    secStr = printf "%02.4f" (secs :: Double)
+    secStr' = (if length secStr < 7 then ('0':) else id) secStr
 
--- | Take a "frame" - delimited sequence - from the input.
--- Returns 'Nothing' if the delimiter does not appear before the stream ends.
-frame :: MonadIO m => ByteString -> C.ConduitM ByteString a m (Maybe ByteString)
-frame delim = input $ B.pack ""
+--------------------------------------------------------------------------------
+-- Conduit utilities
+
+-- | 'CB.take' for strict 'ByteString's.
+c_take :: Monad m => Int -> C.ConduitM ByteString o m ByteString
+c_take = fmap (mconcat . BL.toChunks) . CB.take
+
+-- | Read until the delimiter and return the parts before and after, not
+-- including delimiter.
+c_breakDelim :: Monad m
+             => ByteString
+             -> C.ConduitM ByteString o m (Maybe (ByteString, ByteString))
+c_breakDelim delim = wait_input $ B.empty
   where
-    input front = C.await >>=
+    wait_input front = C.await >>=
       (Nothing <$ C.leftover front) `maybe` \bs ->
 
         let (front', bs') = (<> bs) `second`
               B.splitAt (B.length front - d_len + 1) front
 
         in case B.breakSubstring delim bs' of
-          (part, rest) | B.null rest -> input (front' <> bs')
-                       | otherwise   -> do
-                          leftover $ B.drop d_len rest
-                          return $ Just $ front' <> part
+            (part, rest) | B.null rest -> wait_input $ front' <> bs'
+                         | otherwise   ->
+                           return $ Just (front' <> part, B.drop d_len rest)
 
     d_len = B.length delim
 
--- | Stream delimited chunks.
-frames :: MonadIO m => ByteString -> C.Conduit ByteString m ByteString
-frames delim = frame delim >>=
-                  return () `maybe` ((>> frames delim) . C.yield)
 
-leftover :: Monad m => ByteString -> C.Conduit ByteString m o
-leftover bs | B.null bs = return ()
-            | otherwise = C.leftover bs
+-- | Take a CRLF-delimited line from the input.
+c_line_crlf :: Monad m => C.ConduitM ByteString o m ByteString
+c_line_crlf =
+  c_breakDelim (B.pack "\r\n") >>=
+    return B.empty `maybe` \(line, rest) -> line <$ C.leftover rest
 
-
--- | Convert a 'UTCTime' to a string in ISO 8601 format.
-showUTCTime :: UTCTime -> String
-showUTCTime time = printf "%s %02d:%02d:%s" date hours mins secStr'
+-- | Stream lines delimited by either LF or CRLF.
+c_lines_any :: Monad m => C.Conduit ByteString m ByteString
+c_lines_any = CB.lines C.=$= CL.map strip
   where
-    date = show (utctDay time)
-    (n,d) = (numerator &&& denominator) (toRational $ utctDayTime time)
-    (seconds,frac) = n `divMod` d
-    (hours,(mins,sec)) = second (`divMod` 60) (seconds `divMod` (60^2))
-    secs = fromRational (frac % d) + fromIntegral sec
-    secStr = printf "%02.4f" (secs :: Double)
-    secStr' = (if length secStr < 7 then ('0':) else id) secStr
+    strip bs = case unsnoc bs of
+        Just (bs', '\r') -> bs'
+        _                -> bs
 
 --------------------------------------------------------------------------------
 -- Network functions



_______________________________________________
tor-commits mailing list
tor-commits@xxxxxxxxxxxxxxxxxxxx
https://lists.torproject.org/cgi-bin/mailman/listinfo/tor-commits