commit 1588f46aafe1fc238c6495a4c8e41e7aea3ba7c0 Author: David Kaloper david@numm.org Date: Fri Sep 27 20:12:31 2013 +0200

deal with a bunch of (harmless) warnings --- src/TorDNSEL/Config/Internals.hs | 8 +++---- src/TorDNSEL/Control/Concurrent/Link/Internals.hs | 6 ++--- src/TorDNSEL/Control/Concurrent/Util.hs | 2 -- src/TorDNSEL/DNS/Server/Internals.hs | 4 ++-- src/TorDNSEL/ExitTest/Initiator/Internals.hs | 27 +++++++++++------------ src/TorDNSEL/ExitTest/Request.hs | 4 +--- src/TorDNSEL/ExitTest/Server/Internals.hs | 2 +- src/TorDNSEL/NetworkState/Internals.hs | 2 +- src/TorDNSEL/Socks/Internals.hs | 1 - src/TorDNSEL/Statistics/Internals.hs | 4 ++-- src/TorDNSEL/TorControl/Internals.hs | 3 +-- src/TorDNSEL/Util.hsc | 13 +++-------- tordnsel.cabal | 2 +- 13 files changed, 32 insertions(+), 46 deletions(-)

diff --git a/src/TorDNSEL/Config/Internals.hs b/src/TorDNSEL/Config/Internals.hs index 4b60db7..2830ab6 100644 --- a/src/TorDNSEL/Config/Internals.hs +++ b/src/TorDNSEL/Config/Internals.hs @@ -422,7 +422,7 @@ Otherwise, the server runs with the new configuration and closes the connection: startReconfigServer :: Socket -> (Config -> (Maybe String -> IO ()) -> IO ()) -> IO ReconfigServer startReconfigServer sock sendConfig = do - log Info "Starting reconfigure server." :: IO () + log Info "Starting reconfigure server." chan <- newChan tid <- forkLinkIO $ do setTrapExit $ (writeChan chan .) . Exit @@ -439,7 +439,7 @@ handleMessage s (NewClient client signal) = do str <- B.hGetContents handle case parseConfigFile str >>= makeConfig of Left e -> do - hCat handle "Parse error: " e "\r\n" :: IO () + hCat handle "Parse error: " e "\r\n" log Warn "Parsing config from reconfigure socket failed: " e Right config -> do mv <- newEmptyMVar @@ -451,7 +451,7 @@ handleMessage s (NewClient client signal) = do return s

handleMessage s (Terminate reason) = do - log Info "Terminating reconfigure server." :: IO () + log Info "Terminating reconfigure server." terminateThread Nothing (listenerTid s) (killThread $ listenerTid s) msgs <- untilM (isEmptyChan $ reconfigChan s) (readChan $ reconfigChan s) sequence_ [sClose client | NewClient client _ <- msgs] @@ -460,7 +460,7 @@ handleMessage s (Terminate reason) = do handleMessage s (Exit tid reason) | tid == listenerTid s = do log Warn "The reconfigure listener thread exited unexpectedly: " - (show reason) "; restarting." :: IO () + (show reason) "; restarting." newListenerTid <- forkListener (listenSock s) (writeChan $ reconfigChan s) return s { listenerTid = newListenerTid } | isAbnormal reason = exit reason diff --git a/src/TorDNSEL/Control/Concurrent/Link/Internals.hs b/src/TorDNSEL/Control/Concurrent/Link/Internals.hs index 5c3f8b2..7479cbb 100644 --- a/src/TorDNSEL/Control/Concurrent/Link/Internals.hs +++ b/src/TorDNSEL/Control/Concurrent/Link/Internals.hs @@ -134,7 +134,7 @@ fromExitSignal _ = Nothing -- | The default action used to signal a thread. Abnormal 'ExitReason's are -- sent to the thread and normal exits are ignored. defaultSignal :: C.ThreadId -> ThreadId -> ExitReason -> IO () -defaultSignal dst src NormalExit = return () +defaultSignal _ _ NormalExit = return () defaultSignal dst src e = E.throwTo dst $ ExitSignal src e

-- | Initialize the state supporting links and monitors. It is an error to call @@ -239,8 +239,8 @@ forkLinkIO' shouldLink io = E.mask $ \restore -> do return childId

where - forkHandler io = E.mask_ . C.forkIO $ - (() <$ io) `E.catch` (e :: E.SomeException) -> return () + forkHandler a = E.mask_ . C.forkIO $ + (() <$ a) `E.catch` (_ :: E.SomeException) -> return ()

-- | Establish a bidirectional link between the calling thread and a given -- thread. If either thread terminates, an exit signal will be sent to the other diff --git a/src/TorDNSEL/Control/Concurrent/Util.hs b/src/TorDNSEL/Control/Concurrent/Util.hs index a7c2a65..bd9adff 100644 --- a/src/TorDNSEL/Control/Concurrent/Util.hs +++ b/src/TorDNSEL/Control/Concurrent/Util.hs @@ -15,12 +15,10 @@ module TorDNSEL.Control.Concurrent.Util where import qualified Control.Exception as E import Data.Functor ( (<$) ) import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar, tryPutMVar) -import Data.Dynamic (Dynamic) import Data.Maybe (isJust) import System.Timeout

import TorDNSEL.Control.Concurrent.Link -import TorDNSEL.Util

-- | A type representing a handle to a thread. class Thread a where diff --git a/src/TorDNSEL/DNS/Server/Internals.hs b/src/TorDNSEL/DNS/Server/Internals.hs index 9bc8fc3..5b0f821 100644 --- a/src/TorDNSEL/DNS/Server/Internals.hs +++ b/src/TorDNSEL/DNS/Server/Internals.hs @@ -92,7 +92,7 @@ instance E.Exception DNSMessage -- it. Link the DNS server to the calling thread. startDNSServer :: DNSConfig -> IO DNSServer startDNSServer initConf = do - log Info "Starting DNS server." :: IO () + log Info "Starting DNS server." fmap DNSServer . forkLinkIO . E.block . loop $ initConf where loop conf = do @@ -108,7 +108,7 @@ startDNSServer initConf = do signal loop newConf Left (_,Terminate reason) -> do - log Info "Terminating DNS server." :: IO () + log Info "Terminating DNS server." exit reason Right _ -> loop conf -- impossible

diff --git a/src/TorDNSEL/ExitTest/Initiator/Internals.hs b/src/TorDNSEL/ExitTest/Initiator/Internals.hs index 4605c15..98a9fb6 100644 --- a/src/TorDNSEL/ExitTest/Initiator/Internals.hs +++ b/src/TorDNSEL/ExitTest/Initiator/Internals.hs @@ -58,7 +58,6 @@ import Control.Concurrent.Chan (Chan, newChan, writeChan, readChan) import qualified Control.Exception as E import Control.Monad (replicateM_, guard, when) import qualified Data.ByteString.Char8 as B -import Data.Dynamic (fromDynamic) import qualified Data.Foldable as F import Data.List (foldl', unfoldr, mapAccumL) import qualified Data.Map as M @@ -153,7 +152,7 @@ data TestStatus -- thread. startExitTestInitiator :: ExitTestInitiatorConfig -> IO ExitTestInitiator startExitTestInitiator initConf = do - log Info "Starting exit test initiator." :: IO () + log Info "Starting exit test initiator." chan <- newChan initiatorTid <- forkLinkIO $ do setTrapExit ((writeChan chan .) . Exit) @@ -172,15 +171,15 @@ startExitTestInitiator initConf = do | TestWaiting rid ports published <- testStatus s , canRunExitTest conf s ports = do log Info "Forking exit test clients for router " rid - " ports " ports '.' :: IO () + " ports " ports '.' newClients <- mapM (forkTestClient conf rid published) ports let newRunningClients = foldl' (flip Set.insert) (runningClients s) newClients log Info "Exit test clients currently running: " - (Set.size newRunningClients) '.' :: IO () + (Set.size newRunningClients) '.' if Q.length (pendingTests s) == 0 then do - log Info "Pending exit tests: 0." :: IO () + log Info "Pending exit tests: 0." loop conf s { runningClients = newRunningClients , testStatus = NoTestsPending } else do @@ -201,7 +200,7 @@ handleMessage handleMessage conf s (NewDirInfo routers) | nRouterTests == 0 = return (conf, s) | otherwise = do - log Info "Scheduling exit tests for " nRouterTests " routers." :: IO () + log Info "Scheduling exit tests for " nRouterTests " routers." now <- getCurrentTime let newS = s { pendingTests = newPendingTests , testHistory = appendTestsToHistory now nRouterTests . @@ -237,7 +236,7 @@ handleMessage conf s (Reconfigure reconf signal) = do return (newConf, s)

handleMessage _ s (Terminate reason) = do - log Info "Terminating exit test initiator." :: IO () + log Info "Terminating exit test initiator." F.forM_ (runningClients s) $ \client -> terminateThread Nothing client (killThread client) exit reason @@ -251,13 +250,13 @@ handleMessage conf s (Exit tid reason) routers <- nsRouters `fmap` eticfGetNetworkState conf case testsToExecute conf routers (pendingTests s) of Nothing -> do - log Info "Pending exit tests: 0." :: IO () + log Info "Pending exit tests: 0." return (conf, s { pendingTests = Q.empty , testStatus = NoTestsPending }) Just (rid,ports,published,newPendingTests) -> do - log Info "Pending exit tests: " (Q.length newPendingTests + 1) '.' :: IO () + log Info "Pending exit tests: " (Q.length newPendingTests + 1) '.' log Debug "Waiting to run exit test for router " rid - " ports " ports '.' :: IO () + " ports " ports '.' return (conf, s { pendingTests = newPendingTests , testStatus = TestWaiting rid ports published }) -- Periodically, add every eligible router to the exit test queue. This should @@ -372,13 +371,13 @@ forkTestClient conf rid published port = return () case r of Left (E.fromException -> Just (e :: SocksError)) -> do - log Info "Exit test for router " rid " port " port " failed: " e :: IO () + log Info "Exit test for router " rid " port " port " failed: " e E.throwIO e Left (E.fromException -> Just (e :: E.IOException)) -> do log Warn "Exit test for router " rid " port " port " failed : " e ". This might indicate a problem with making application \ \connections through Tor. Is Tor running? Is its SocksPort \ - \listening on " (eticfSocksServer conf) '?' :: IO () + \listening on " (eticfSocksServer conf) '?' E.throwIO e Left e -> E.throwIO e Right Nothing -> @@ -402,8 +401,8 @@ forkTestTimer :: InitiatorState -> IO ThreadId forkTestTimer s = forkLinkIO $ do log Debug "Total routers scheduled in exit test history: " (nTotalRouters $ testHistory s) ". " - (show . F.toList . historySeq $ testHistory s) :: IO () - log Info "Running next exit test in " currentInterval " microseconds." :: IO () + (show . F.toList . historySeq $ testHistory s) + log Info "Running next exit test in " currentInterval " microseconds." threadDelay $ fromIntegral currentInterval where currentInterval = currentTestInterval nPending (testHistory s) diff --git a/src/TorDNSEL/ExitTest/Request.hs b/src/TorDNSEL/ExitTest/Request.hs index 82e198c..4634e8d 100644 --- a/src/TorDNSEL/ExitTest/Request.hs +++ b/src/TorDNSEL/ExitTest/Request.hs @@ -26,13 +26,11 @@ module TorDNSEL.ExitTest.Request ( , cookieLen ) where

-import Control.Arrow ((***), second) +import Control.Arrow ((***)) import Control.Applicative import Control.Monad -import Control.Monad.Trans (lift, liftIO) import Data.Monoid import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy as BL import Data.Char (isSpace, toLower) import qualified Data.Map as M import System.IO (Handle) diff --git a/src/TorDNSEL/ExitTest/Server/Internals.hs b/src/TorDNSEL/ExitTest/Server/Internals.hs index 13e2136..8d6377b 100644 --- a/src/TorDNSEL/ExitTest/Server/Internals.hs +++ b/src/TorDNSEL/ExitTest/Server/Internals.hs @@ -32,7 +32,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.Foldable as F import qualified Data.Map as M import Data.Map (Map) -import Data.Maybe (catMaybes, fromJust, isJust) +import Data.Maybe import qualified Data.Set as S import Data.Set (Set) import Data.Time (UTCTime, getCurrentTime) diff --git a/src/TorDNSEL/NetworkState/Internals.hs b/src/TorDNSEL/NetworkState/Internals.hs index c4c6b4d..49e8be5 100644 --- a/src/TorDNSEL/NetworkState/Internals.hs +++ b/src/TorDNSEL/NetworkState/Internals.hs @@ -67,7 +67,7 @@ import qualified Control.Exception as E import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString) import Data.List (foldl') -import Data.Maybe (mapMaybe, isJust, fromMaybe) +import Data.Maybe import qualified Data.Map as M import Data.Map (Map) import qualified Data.Set as S diff --git a/src/TorDNSEL/Socks/Internals.hs b/src/TorDNSEL/Socks/Internals.hs index 9f94b45..0367cc3 100644 --- a/src/TorDNSEL/Socks/Internals.hs +++ b/src/TorDNSEL/Socks/Internals.hs @@ -42,7 +42,6 @@ import qualified Control.Exception as E import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.Dynamic (Dynamic, fromDynamic) import Data.Typeable (Typeable) import Network.Socket (HostAddress) import System.IO (Handle, BufferMode(NoBuffering), hClose, hSetBuffering) diff --git a/src/TorDNSEL/Statistics/Internals.hs b/src/TorDNSEL/Statistics/Internals.hs index d05da2c..8ed2808 100644 --- a/src/TorDNSEL/Statistics/Internals.hs +++ b/src/TorDNSEL/Statistics/Internals.hs @@ -26,7 +26,7 @@ import qualified Control.Exception as E import Control.Monad (when, forever) import Control.Monad.Fix (fix) import qualified Data.ByteString.Char8 as B -import Data.Maybe (isJust, isNothing) +import Data.Maybe import qualified Data.Set as S import Network.Socket (accept, socketToHandle, Socket) import System.IO (hClose, IOMode(ReadWriteMode)) @@ -118,7 +118,7 @@ startStatsServer listenSock = do let newHandlers = S.delete tid (handlers s) case terminateReason s of -- all the handlers have finished, so let's exit - Just exitReason | S.null newHandlers -> exit exitReason + Just reason | S.null newHandlers -> exit reason _ -> loop s { handlers = newHandlers } | isAbnormal reason -> exit reason | otherwise -> loop s diff --git a/src/TorDNSEL/TorControl/Internals.hs b/src/TorDNSEL/TorControl/Internals.hs index 7e0b8f1..58c64ef 100644 --- a/src/TorDNSEL/TorControl/Internals.hs +++ b/src/TorDNSEL/TorControl/Internals.hs @@ -145,10 +145,9 @@ import Control.Applicative import qualified Data.ByteString.Char8 as B import Data.ByteString (ByteString) import Data.Char (isSpace, isAlphaNum, isDigit, isAlpha, toLower) -import Data.Dynamic (Dynamic, fromDynamic) import Data.List (find) import qualified Data.Map as M -import Data.Maybe (fromMaybe, maybeToList, listToMaybe, isNothing, isJust) +import Data.Maybe import qualified Data.Sequence as S import Data.Sequence ((<|), ViewR((:>)), viewr) import Data.Time (UTCTime, TimeZone, localTimeToUTC, getCurrentTimeZone) diff --git a/src/TorDNSEL/Util.hsc b/src/TorDNSEL/Util.hsc index 6bbffc3..51c7664 100644 --- a/src/TorDNSEL/Util.hsc +++ b/src/TorDNSEL/Util.hsc @@ -109,25 +109,19 @@ module TorDNSEL.Util (

import Control.Arrow ((&&&), first, second) import Control.Applicative +import Control.Monad import qualified Control.Exception as E -import Control.Monad.Error - (Error(..), MonadError(..), MonadTrans(..), MonadIO(..)) +import Control.Monad.Error (Error(..), MonadError(..), MonadTrans(..), MonadIO(..)) import qualified Control.Monad.State as State -import Control.Monad.State - (MonadState, liftM, liftM2, zipWithM_, when, unless, guard, MonadPlus(..)) -import Data.Array.ST (runSTUArray, newArray_, readArray, writeArray) -import Data.Array.Unboxed ((!)) +import Control.Monad.State (MonadState) import Data.Bits ((.&.), (.|.), shiftL, shiftR) import Data.Char (intToDigit, showLitChar, isPrint, isControl, chr, ord, digitToInt, isAscii) -import Data.Dynamic (Dynamic) import Data.List (foldl', intersperse) -import Data.Maybe (mapMaybe) import Data.Monoid import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Internal as B (c2w) -import qualified Data.ByteString as B (hGetSome) import Data.ByteString (ByteString) import qualified Data.Map as M import Data.Ratio (numerator, denominator, (%)) @@ -143,7 +137,6 @@ import System.Directory (doesFileExist, removeFile) import System.Environment (getProgName) import System.Exit (exitWith, ExitCode) import System.IO (Handle, hPutStr) -import System.IO.Error (isEOFError) import System.Posix.Files (setFileMode) import System.Posix.Types (FileMode) import Text.Printf (printf) diff --git a/tordnsel.cabal b/tordnsel.cabal index 50e7f40..827256e 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 -funbox-strict-fields -Wall -Werror +GHC-Options: -O2 -funbox-strict-fields -fno-warn-unused-do-bind -Wall -Werror CPP-Options: -DVERSION="0.1.1-dev" Extensions: FlexibleContexts FlexibleInstances