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

[tor-dev] PRELIMINARY: [PATCH 3/3] Replace 'TorDNSEL.System.Timeout' with 'System.Timeout'.



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