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

[tor-dev] [PATCH] Allow tordnsel to build on Squeeze



Hi!

Quoting IRC:

  <phobos> I give up on tordnsel, I'm unable to get git head to compile
           in squeeze

Attached are 3 patches that allow tordnsel to build on a Squeeze system.
I unfortunately lack a test environment to ensure that the resulting
binary works fine. Haskell has proven quite trusty, though.

The work needed to make it work for the next versions of GHC (7.x) is
going to be an order of magnitude bigger, so it probably makes sense to
get the Python implementation working until Squeeze is EOL.

Cheers,
-- 
JÃrÃmy Bobbio                        .''`. 
lunar@xxxxxxxxxx                    : :â  :  # apt-get install anarchism
                                    `. `'` 
                                      `-   
From e21b7eaf5f54f5c56cd59c8651d0cf4bf1b6e3cf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=A9my=20Bobbio?= <lunar@xxxxxxxxxx>
Date: Sun, 19 Jun 2011 21:32:05 +0200
Subject: [PATCH 1/3] Fix cabal warning

`-D` is actually an option relevant to the preprocessor and not GHC itself, so
move it to CPP-Options, as suggested.
---
 tordnsel.cabal |    3 ++-
 1 files changed, 2 insertions(+), 1 deletions(-)

diff --git a/tordnsel.cabal b/tordnsel.cabal
index 10f2bbb..b932533 100644
--- a/tordnsel.cabal
+++ b/tordnsel.cabal
@@ -59,7 +59,8 @@ 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.0.6-dev"
+GHC-Options:     -O2 -Wall -Werror
+CPP-Options:     -DVERSION="0.0.6-dev"
 
 Executable:      runtests
 Buildable:       False
-- 
1.7.2.5

From a114bdb9a296071c7b08761283c2a5bf17c3c2c4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=A9my=20Bobbio?= <lunar@xxxxxxxxxx>
Date: Sun, 19 Jun 2011 23:16:26 +0200
Subject: [PATCH 2/3] Reimplement hGetLine (in a more stupid way)

hGetLine was previously neat and clever, but it does not build with GHC 6.12.
All callers were actually looking for "\n" or "\r\n". So let's simplify, look
out for '\n' and strip '\r' if it is the character right before.
---
 src/TorDNSEL/ExitTest/Request.hs     |    4 +-
 src/TorDNSEL/TorControl/Internals.hs |    4 +-
 src/TorDNSEL/Util.hsc                |  124 +++++-----------------------------
 3 files changed, 21 insertions(+), 111 deletions(-)

diff --git a/src/TorDNSEL/ExitTest/Request.hs b/src/TorDNSEL/ExitTest/Request.hs
index 87a2fbd..570699b 100644
--- a/src/TorDNSEL/ExitTest/Request.hs
+++ b/src/TorDNSEL/ExitTest/Request.hs
@@ -73,14 +73,14 @@ getRequest client = do
     crlfLen = 2
 
     getHeader = do
-      reqLine <- hGetLine client crlf maxHeaderLen
+      reqLine <- hGetLine client 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
+          header <- hGetLine client remain
           if B.null header
             then return []
             else do
diff --git a/src/TorDNSEL/TorControl/Internals.hs b/src/TorDNSEL/TorControl/Internals.hs
index 015bd76..bace805 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 =<< hGetLine handle maxLineLength
       case line of
         MidReply reply  -> fmap (reply :) readReplies
         LastReply reply -> return [reply]
@@ -865,7 +865,7 @@ startSocketReader handle sendRepliesToIOManager =
                       cat "Malformed reply line type " (esc 1 typ) '.'
 
     readData = do
-      line <- hGetLine handle (B.pack "\n") maxLineLength
+      line <- hGetLine handle 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
diff --git a/src/TorDNSEL/Util.hsc b/src/TorDNSEL/Util.hsc
index bb81b43..0f471fd 100644
--- a/src/TorDNSEL/Util.hsc
+++ b/src/TorDNSEL/Util.hsc
@@ -132,18 +132,12 @@ import Network.Socket
 import System.Directory (doesFileExist, removeFile)
 import System.Environment (getProgName)
 import System.Exit (exitWith, ExitCode)
-import System.IO (hPutStr)
+import System.IO (Handle, hPutStr, hGetChar)
 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 Data.Binary (Binary(..))
 
 import TorDNSEL.DeepSeq
@@ -368,113 +362,29 @@ 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
+-- | Read a line terminated by an LF or CRLF 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_
+hGetLine :: Handle -> Int -> IO ByteString
+hGetLine h maxLen =
+  do str <- readStr maxLen B.empty
+     let result = case B.uncons str of
+           Nothing           -> B.empty
+           Just ('\r', str') -> str'
+           Just _            -> str
+     return $ B.reverse result
 
   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)
+
+  readStr 0   str = return str
+  readStr rem str = catch
+      (do c <- hGetChar h
+          if c == '\n' then return str
+                       else readStr (rem - 1) (c `B.cons` str))
+      (\e -> if isEOFError e then return str else ioError e)
 
 -- | Split @bs@ into pieces delimited by @delimiter@, consuming the delimiter.
 -- The result for overlapping delimiters is undefined.
-- 
1.7.2.5

From cff25673b99a4e776b97635e59308f6957b38ccd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=A9my=20Bobbio?= <lunar@xxxxxxxxxx>
Date: Sun, 19 Jun 2011 23:29:54 +0200
Subject: [PATCH 3/3] Continue using Control.OldException with GHC 6.12

We also need to build without -Werror as OldException are very much deprecated.
---
 src/TorDNSEL/Compat/Exception.hs |    2 +-
 tordnsel.cabal                   |    2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/TorDNSEL/Compat/Exception.hs b/src/TorDNSEL/Compat/Exception.hs
index b206513..73249ce 100644
--- a/src/TorDNSEL/Compat/Exception.hs
+++ b/src/TorDNSEL/Compat/Exception.hs
@@ -19,7 +19,7 @@ module TorDNSEL.Compat.Exception (
     module Exception
   ) where
 
-#if __GLASGOW_HASKELL__ == 610
+#if (__GLASGOW_HASKELL__ == 610) || (__GLASGOW_HASKELL__ == 612)
 import Control.OldException as Exception
 #else
 import Control.Exception as Exception
diff --git a/tordnsel.cabal b/tordnsel.cabal
index b932533..a7942ca 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
+GHC-Options:     -O2 -Wall
 CPP-Options:     -DVERSION="0.0.6-dev"
 
 Executable:      runtests
-- 
1.7.2.5

Attachment: signature.asc
Description: Digital signature

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