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

[tor-dev] PRELIMINARY: [PATCH] Adapt to changes in 'GHC.Handle'. (was: Haskell packages?)



> In order to have TorDNSEL work on Debian Squeeze, I did some small
> changes to make it uses Control.OldException. But this does not work
> anymore on GHC 7.4. The later is the version currently in Debian Wheezy.

Hm, I can't build it with GHC 6.10.4.  'cabal build' returns the
following:

src/TorDNSEL/Compat/Exception.hs:23:7:
    Could not find module `Control.OldException':
      it is a member of the hidden package `base'
      Use -v to see a list of the files searched for.

(Oh, I guess I've just found a workaround.  I'll try it later.)

I tried with GHC 6.12.1 as well:

src/TorDNSEL/Util.hsc:143:23:
    Module `GHC.Handle' does not export `fillReadBuffer'

src/TorDNSEL/Util.hsc:143:39:
    Module `GHC.Handle' does not export `readCharFromBuffer'

src/TorDNSEL/Util.hsc:145:26:
    Module `GHC.IOBase' does not export `Buffer(..)'

GHC 6.12.1 uses a different version of 'base' (see [1]).  That's why
the above errors appeared.

After that I also tried to build with GHC 7.6.3 and got the same
errors.  What version of GHC do you use?  What about versions of
libraries?  Note that 'tordnsel.cabal' says that the package should
work with GHC 6.6, GHC 6.8, GHC 6.10, and GHC 6.12.

I'm attaching two /preliminary/ patches:

  * The first patch removes '-Werror' from 'tordnsel.cabal'.  I guess
    that '-Werror' shouldn't be there because "Hackage prevents people
    uploading packages with '-Werror' in their '.cabal' file" [2].  But
    I'd prefer to fix other 'cabal'-related warnings before pushing, for
    instance:

    Warning: Instead of 'ghc-options: -DVERSION="0.1.1-dev"' use 'cpp-options:
    -DVERSION="0.1.1-dev"'

    This patch is needed to produce more verbose error messages on
    'cabal build'.

  * The second patch tries to adapt to changes in 'GHC.Handle'.

If you apply both patches (with GHC 7.6.3), the following errors will
appear:

[ 3 of 39] Compiling TorDNSEL.Compat.Exception ( src/TorDNSEL/Compat/Exception.hs, dist/build/tordnsel/tordnsel-tmp/TorDNSEL/Compat/Exception.o ) [dist/build/autogen/cabal_macros.h changed]
[ 4 of 39] Compiling TorDNSEL.System.Timeout ( src/TorDNSEL/System/Timeout.hs, dist/build/tordnsel/tordnsel-tmp/TorDNSEL/System/Timeout.o )

I don't know how many things I'll have to change to build TorDNSEL.
I know about changes in 'base', exceptions, and 'binary'.  For
example:

  - Compare [3] and [4];
  - This version [5] doesn't have 'lookAhead', which is used in
    TorDNSEL.

('tordnsel.cabal' should be adjusted accordingly, by the way.)

My plan is to build TorDNSEL first.  I assume it'll take a lot of time.
So I decided not to look through 'getRequest', 'hGetLine',
'startSocketReader', and other affected functions at this point.
Basically, 'hGetLineN' is based on a docstring of 'hGetLine' and its
type declaration.

I'd like to send more preliminary patches if you don't mind.  That
will help to ensure that I'm on the right track.  Also, it's possible
that someone will be able to spot bugs at preliminary stages.

I'll inspect each preliminary patch when I build the program.

What do you think?

[1] http://www.haskell.org/ghc/docs/6.12.1/html/users_guide/release-6-12-1.html
[2] http://stackoverflow.com/a/5588790
[3] http://hackage.haskell.org/packages/archive/binary/0.4.5/doc/html/src/Data-Binary-Get.html#Get
[4] http://hackage.haskell.org/packages/archive/binary/0.7.1.0/doc/html/src/Data-Binary-Get-Internal.html#Get
[5] http://hackage.haskell.org/packages/archive/binary/0.6.0.0/doc/html/src/Data-Binary-Get.html

From 5e8efa7bbca93fdf7a2b8a541181aa2aefe590db Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
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

From fe0463875af59ced0796c832034a05b363b83b85 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Tue, 11 Jun 2013 17:24:05 +0000
Subject: [PATCH] Remove '-Werror' from 'tordnsel.cabal'.

---
 tordnsel.cabal |    4 ++--
 1 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/tordnsel.cabal b/tordnsel.cabal
index 243e026..da9dc1e 100644
--- a/tordnsel.cabal
+++ b/tordnsel.cabal
@@ -59,7 +59,7 @@ Other-Modules:   TorDNSEL.Config,
 HS-Source-Dirs:  src
 Includes:        sys/types.h, unistd.h, sysexits.h, netinet/in.h, openssl/rand.h
 Extra-Libraries: crypto
-GHC-Options:     -O2 -Wall -Werror -DVERSION="0.1.1-dev"
+GHC-Options:     -O2 -Wall -DVERSION="0.1.1-dev"
 
 Executable:      runtests
 Buildable:       False
@@ -71,4 +71,4 @@ Other-Modules:   TorDNSEL.Config.Tests,
 HS-Source-Dirs:  src
 Includes:        netinet/in.h, openssl/rand.h
 Extra-Libraries: crypto
-GHC-Options:     -fasm -Wall -Werror -fno-warn-missing-signatures
+GHC-Options:     -fasm -Wall -fno-warn-missing-signatures
-- 
1.7.5.4

Attachment: pgp7GXCtpkc_6.pgp
Description: PGP signature

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