I apologize for the delay. Here are three patches. The first one deals with this issue: "GHC was recently changed to not allow you to use newtypes in FFI imports unless the constructor of the newtype is in scope." [1] The second patch removes a redundant function and adjusts some imports. (I wrote a version of 'splitByDelimiter' that uses 'B.breakSubstring' instead of 'B.findSubstrings'. Let me know if you want to keep 'splitByDelimiter', and I'll use that version.) The third patch removes 'TorDNSEL.System.Timeout'. There is a similar module in 'base' (see [2], for instance). In TorDNSEL, this line (bracket (forkIO (threadDelay n >> throwDynTo pid ex)) wraps a 'Timeout' exception into 'Dynamic' [3] and raises the exception after 'n' microseconds. And this one handleJust (\e -> dynExceptions e >>= fromDynamic >>= guard . (ex ==)) catches dynamic exceptions and compares them with the 'Timeout' exception. I think there is no need to use dynamic exceptions at all. The latest version of 'System.Timeout' [4] is also similar but uses 'forkIOWithUnmask' [5]. It seems safer because it doesn't rely on 'MaskingState' [6] of a parent thread (also, see [7]). There is another reason to remove 'TorDNSEL.System.Timeout': it's the only module that is not in the public domain. If you apply the attached patches on top of the previous patchset [8], you should see some exception-related errors, which I haven't fixed yet. (Don't forget that the mentioned patches are preliminary and need additional testing.) [1] http://ghc.haskell.org/trac/ghc/ticket/5610 [2] http://hackage.haskell.org/packages/archive/base/4.1.0.0/doc/html/src/System-Timeout.html [3] http://hackage.haskell.org/packages/archive/base/4.1.0.0/doc/html/Control-OldException.html#v%3AthrowDynTo [4] http://hackage.haskell.org/packages/archive/base/4.6.0.1/doc/html/src/System-Timeout.html#timeout [5] http://hackage.haskell.org/packages/archive/base/4.6.0.1/doc/html/src/GHC-Conc-Sync.html#forkIOWithUnmask [6] http://hackage.haskell.org/packages/archive/base/4.6.0.1/doc/html/src/GHC-IO.html#MaskingState [7] http://ofps.oreilly.com/titles/9781449335946/sec_cancellation.html [8] https://lists.torproject.org/pipermail/tor-dev/2013-July/005134.html
From c601fadf07e4b48c0bea7c2e081ba371cc60a4bc Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx> Date: Mon, 22 Jul 2013 04:06:40 +0000 Subject: [PATCH 1/3] Do not use 'GHC.IOBase' and 'B.findSubstrings'. * src/TorDNSEL/Util.hsc: Use 'GHC.IO.Handle.Types' and 'GHC.IORef' instead of 'GHC.IOBase'. (splitByDelimiter): Remove it. --- src/TorDNSEL/Util.hsc | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/src/TorDNSEL/Util.hsc b/src/TorDNSEL/Util.hsc index 0ba7365..f71cf99 100644 --- a/src/TorDNSEL/Util.hsc +++ b/src/TorDNSEL/Util.hsc @@ -3,8 +3,6 @@ UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans -Wwarn #-} --- ^^^^^^ --- XXX: findSubstrings is deprecated ----------------------------------------------------------------------------- -- | @@ -59,7 +57,6 @@ module TorDNSEL.Util ( , htonl , ntohl , hGetLineN - , splitByDelimiter , showException , showUTCTime @@ -139,7 +136,8 @@ import System.Posix.Types (FileMode) import Text.Printf (printf) import GHC.IO.Handle (BufferMode(..)) -import GHC.IOBase (Handle, Handle__(..), readIORef, writeIORef) +import GHC.IO.Handle.Types (Handle, Handle__(..)) +import GHC.IORef (readIORef, writeIORef) import Data.Binary (Binary(..)) @@ -374,16 +372,6 @@ hGetLineN handle eol n = do 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. -splitByDelimiter :: ByteString -> ByteString -> [ByteString] -splitByDelimiter delimiter bs = subst (-len : B.findSubstrings delimiter bs) - where - subst (x:xs@(y:_)) = B.take (y-x-len) (B.drop (x+len) bs) : subst xs - subst [x] = [B.drop (x+len) bs] - subst [] = error "splitByDelimiter: empty list" - len = B.length delimiter - -- | Convert an exception to a string given a list of functions for displaying -- dynamically typed exceptions. showException :: [Dynamic -> Maybe String] -> E.SomeException -> String -- 1.7.9.5
From 4a1353c43a3734345c933446d5b1de6a062512f7 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx> Date: Thu, 18 Jul 2013 00:23:18 +0000 Subject: [PATCH 2/3] Import the 'CInt' constructor properly. --- src/TorDNSEL/Random.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/TorDNSEL/Random.hs b/src/TorDNSEL/Random.hs index 8464223..69c254d 100644 --- a/src/TorDNSEL/Random.hs +++ b/src/TorDNSEL/Random.hs @@ -26,7 +26,7 @@ import System.Directory (doesFileExist) import System.IO (Handle, openFile, IOMode(ReadMode)) import Foreign (Ptr, Word8, withForeignPtr, plusPtr) -import Foreign.C.Types (CInt) +import Foreign.C.Types (CInt(..)) import TorDNSEL.Util -- 1.7.9.5
From cb7bfa4c324f8c2bb4e769c1f067e08b2859354f Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx> Date: Mon, 22 Jul 2013 04:16:28 +0000 Subject: [PATCH 3/3] Replace 'TorDNSEL.System.Timeout' with 'System.Timeout'. * src/TorDNSEL/System: Remove it. * tordnsel.cabal (Other-Modules): Remove 'TorDNSEL.System.Timeout'. * src/TorDNSEL/Control/Concurrent/Util.hs, src/TorDNSEL/ExitTest/Initiator/Internals.hs, src/TorDNSEL/ExitTest/Server/Internals.hs, src/TorDNSEL/Statistics/Internals.hs: Use 'System.Timeout' instead. --- src/TorDNSEL/Control/Concurrent/Util.hs | 2 +- src/TorDNSEL/ExitTest/Initiator/Internals.hs | 2 +- src/TorDNSEL/ExitTest/Server/Internals.hs | 2 +- src/TorDNSEL/Statistics/Internals.hs | 2 +- src/TorDNSEL/System/Timeout.hs | 106 -------------------------- tordnsel.cabal | 1 - 6 files changed, 4 insertions(+), 111 deletions(-) delete mode 100644 src/TorDNSEL/System/Timeout.hs diff --git a/src/TorDNSEL/Control/Concurrent/Util.hs b/src/TorDNSEL/Control/Concurrent/Util.hs index 05e71b4..b502f4b 100644 --- a/src/TorDNSEL/Control/Concurrent/Util.hs +++ b/src/TorDNSEL/Control/Concurrent/Util.hs @@ -18,7 +18,7 @@ import Data.Dynamic (Dynamic) import Data.Maybe (isJust) import TorDNSEL.Control.Concurrent.Link -import TorDNSEL.System.Timeout +import System.Timeout import TorDNSEL.Util -- | A type representing a handle to a thread. diff --git a/src/TorDNSEL/ExitTest/Initiator/Internals.hs b/src/TorDNSEL/ExitTest/Initiator/Internals.hs index 06e4250..4be908a 100644 --- a/src/TorDNSEL/ExitTest/Initiator/Internals.hs +++ b/src/TorDNSEL/ExitTest/Initiator/Internals.hs @@ -91,7 +91,7 @@ import TorDNSEL.ExitTest.Request import TorDNSEL.Log import TorDNSEL.NetworkState.Types import TorDNSEL.Socks -import TorDNSEL.System.Timeout +import System.Timeout import TorDNSEL.Util -------------------------------------------------------------------------------- diff --git a/src/TorDNSEL/ExitTest/Server/Internals.hs b/src/TorDNSEL/ExitTest/Server/Internals.hs index 4f62f37..6f7eb42 100644 --- a/src/TorDNSEL/ExitTest/Server/Internals.hs +++ b/src/TorDNSEL/ExitTest/Server/Internals.hs @@ -46,7 +46,7 @@ import TorDNSEL.Control.Concurrent.Link import TorDNSEL.Control.Concurrent.Util import TorDNSEL.ExitTest.Request import TorDNSEL.Log -import TorDNSEL.System.Timeout +import System.Timeout import TorDNSEL.Util -- | A handle to the exit test server thread. diff --git a/src/TorDNSEL/Statistics/Internals.hs b/src/TorDNSEL/Statistics/Internals.hs index d4ef165..b1b505f 100644 --- a/src/TorDNSEL/Statistics/Internals.hs +++ b/src/TorDNSEL/Statistics/Internals.hs @@ -36,7 +36,7 @@ import TorDNSEL.Control.Concurrent.Link import TorDNSEL.Control.Concurrent.Util import TorDNSEL.DNS.Server import TorDNSEL.Log -import TorDNSEL.System.Timeout +import System.Timeout import TorDNSEL.Util -- | Cumulative counts of bytes transferred, datagrams received, and responses diff --git a/src/TorDNSEL/System/Timeout.hs b/src/TorDNSEL/System/Timeout.hs deleted file mode 100644 index 761ae16..0000000 --- a/src/TorDNSEL/System/Timeout.hs +++ /dev/null @@ -1,106 +0,0 @@ -{-# OPTIONS -fglasgow-exts #-} -{- -The Glasgow Haskell Compiler License - -Copyright 2004, The University Court of the University of Glasgow. -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -- Neither name of the University nor the names of its contributors may be -used to endorse or promote products derived from this software without -specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF -GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. --} - -------------------------------------------------------------------------------- --- | --- Module : TorDNSEL.System.Timeout --- Copyright : (c) The University of Glasgow 2007 --- License : BSD-style --- --- Maintainer : libraries@xxxxxxxxxxx --- Stability : experimental --- Portability : non-portable --- --- Attach a timeout event to arbitrary 'IO' computations. --- -------------------------------------------------------------------------------- - -module TorDNSEL.System.Timeout ( timeout ) where - -import Prelude (IO, Ord((<)), Eq((==)), Int, (.), otherwise, fmap) -import Data.Maybe (Maybe(..)) -import Control.Monad (Monad(..), guard) -import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread) -import TorDNSEL.Compat.Exception (handleJust, throwDynTo, dynExceptions, bracket) -import Data.Dynamic (Typeable, fromDynamic) -import Data.Unique (Unique, newUnique) - --- An internal type that is thrown as a dynamic exception to --- interrupt the running IO computation when the timeout has --- expired. - -data Timeout = Timeout Unique deriving (Eq, Typeable) - --- |Wrap an 'IO' computation to time out and return @Nothing@ in case no result --- is available within @n@ microseconds (@1\/10^6@ seconds). In case a result --- is available before the timeout expires, @Just a@ is returned. A negative --- timeout interval means \"wait indefinitely\". When specifying long timeouts, --- be careful not to exceed @maxBound :: Int@. --- --- The design of this combinator was guided by the objective that @timeout n f@ --- should behave exactly the same as @f@ as long as @f@ doesn't time out. This --- means that @f@ has the same 'myThreadId' it would have without the timeout --- wrapper. Any exceptions @f@ might throw cancel the timeout and propagate --- further up. It also possible for @f@ to receive exceptions thrown to it by --- another thread. --- --- A tricky implementation detail is the question of how to abort an @IO@ --- computation. This combinator relies on asynchronous exceptions internally. --- The technique works very well for computations executing inside of the --- Haskell runtime system, but it doesn't work at all for non-Haskell code. --- Foreign function calls, for example, cannot be timed out with this --- combinator simply because an arbitrary C function cannot receive --- asynchronous exceptions. When @timeout@ is used to wrap an FFI call that --- blocks, no timeout event can be delivered until the FFI call returns, which --- pretty much negates the purpose of the combinator. In practice, however, --- this limitation is less severe than it may sound. Standard I\/O functions --- like 'System.IO.hGetBuf', 'System.IO.hPutBuf', 'Network.Socket.accept', or --- 'System.IO.hWaitForInput' appear to be blocking, but they really don't --- because the runtime system uses scheduling mechanisms like @select(2)@ to --- perform asynchronous I\/O, so it is possible to interrupt standard socket --- I\/O or file I\/O using this combinator. - -timeout :: Int -> IO a -> IO (Maybe a) -timeout n f - | n < 0 = fmap Just f - | n == 0 = return Nothing - | otherwise = do - pid <- myThreadId - ex <- fmap Timeout newUnique - handleJust (\e -> dynExceptions e >>= fromDynamic >>= guard . (ex ==)) - (\_ -> return Nothing) - (bracket (forkIO (threadDelay n >> throwDynTo pid ex)) - (killThread) - (\_ -> fmap Just f)) diff --git a/tordnsel.cabal b/tordnsel.cabal index 6268544..73376d1 100644 --- a/tordnsel.cabal +++ b/tordnsel.cabal @@ -58,7 +58,6 @@ Executable tordnsel TorDNSEL.Socks.Internals, TorDNSEL.Statistics, TorDNSEL.Statistics.Internals, - TorDNSEL.System.Timeout, TorDNSEL.TorControl, TorDNSEL.TorControl.Internals, TorDNSEL.Util -- 1.7.9.5
Attachment:
pgpwzvvMvVuk7.pgp
Description: PGP signature
_______________________________________________ tor-dev mailing list tor-dev@xxxxxxxxxxxxxxxxxxxx https://lists.torproject.org/cgi-bin/mailman/listinfo/tor-dev