network-anonymous-tor 0.9.2 → 0.10.0
raw patch · 13 files changed
+959/−918 lines, 13 filessetup-changed
Files
- LICENSE +22/−22
- README.md +9/−9
- Setup.hs +3/−3
- examples/Relay.lhs +89/−89
- network-anonymous-tor.cabal +95/−95
- src/Network/Anonymous/Tor.hs +179/−179
- src/Network/Anonymous/Tor/Error.hs +63/−63
- src/Network/Anonymous/Tor/Protocol.hs +247/−206
- src/Network/Anonymous/Tor/Protocol/Parser.hs +135/−135
- src/Network/Anonymous/Tor/Protocol/Parser/Ast.hs +74/−74
- src/Network/Anonymous/Tor/Protocol/Types.hs +32/−32
- test/Main.hs +10/−10
- test/Spec.hs +1/−1
LICENSE view
@@ -1,22 +1,22 @@-The MIT License (MIT) - -Copyright (c) 2015 Leon Mergen - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. - +The MIT License (MIT)++Copyright (c) 2015 Leon Mergen++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.+
README.md view
@@ -1,9 +1,9 @@-network-anonymous-tor -===================== - -[](https://travis-ci.org/solatis/haskell-network-anonymous-tor) -[](https://coveralls.io/r/solatis/haskell-network-anonymous-tor?branch=master) -[](http://en.wikipedia.org/wiki/MIT_License) -[](http://haskell.org) - -network-anonymous-tor is a Haskell API for Tor anonymous networking +network-anonymous-tor+=====================++[](https://travis-ci.org/solatis/haskell-network-anonymous-tor)+[](https://coveralls.io/r/solatis/haskell-network-anonymous-tor?branch=master)+[](http://en.wikipedia.org/wiki/MIT_License)+[](http://haskell.org)++network-anonymous-tor is a Haskell API for Tor anonymous networking
Setup.hs view
@@ -1,3 +1,3 @@-import Distribution.Simple - -main = defaultMain +import Distribution.Simple++main = defaultMain
examples/Relay.lhs view
@@ -1,89 +1,89 @@-> import System.Environment (getArgs) -> import Control.Concurrent (threadDelay, forkIO) -> import Control.Monad (void) -> import System.IO (IOMode (ReadWriteMode)) - -> import Network (withSocketsDo) -> import qualified Network.Simple.TCP as NST -> import Network.Socket (socketToHandle) -> import qualified Network.Socket.Splice as Splice - -> import qualified Network.Anonymous.Tor as Tor - -Our main function is fairly simple: get our configuration data and start -a new Tor Session. As soon as this session completes, exit the program. - -> main = withSocketsDo $ do -> torPort <- whichControlPort -> portmap <- getPortmap - -Once we got the configuration data, launch a Tor session and will continue -execution in the 'withinSession' function. - -> Tor.withSession torPort (withinSession portmap) -> -> where - -We need a simple function to detect which control port Tor listens at. By -default the Tor service uses port 9051, but the Tor Browser Bundle uses 9151, -to allow Tor and the TBB to run next to each other. - -> whichControlPort = do -> let ports = [9051, 9151] -> -> availability <- mapM Tor.isAvailable ports - -At this point, the `ports` list describes the list of ports in which we think -a Tor controller might be active, and `availability` has a list of the same length -with the associated availability status. - -Since we're only interested in services that are available, we are going to -combine these list, filter on the availability status, and return the first port -that matches these constraints. This functionality is relatively unsafe, since -it assumes at least one Tor service is running (otherwise 'head' will return an -error). - -> return . fst . head . filter ((== Tor.Available) . snd) $ zip ports availability - -Some boilerplate code: we need to set up a port mapping, and rather than hard- -coding it, we allow the user to provide is as command line arguments. The first -argument is the public port we will listen at, the second argument the private -port we relay connections to. - -> getPortmap :: IO (Integer, Integer) -> getPortmap = do -> [pub, priv] <- getArgs -> return (read pub, read priv) - -Once a Tor session has been created and we are authenticated with the Tor -control service, let's set up a new onion service which redirects incoming -connections to the 'newConnection' function. - -> withinSession (publicPort, privatePort) controlSock = do -> onion <- Tor.accept controlSock publicPort (newConnection privatePort) -> putStrLn ("hidden service descriptor: " ++ show onion) - -If we would leave this function at this point, our connection with the Tor -control service would be lost, which would cause Tor to clean up any mappings -and hidden services we have registered. - -Since this is just an example, we will now wait for 5 minutes and then exit. - -> threadDelay 300000000 - -This function is called for all incoming connections. All it needs to do is -establish a connection with the local service and relay the connections to the -local, private server. - -> newConnection privatePort sPublic = -> NST.connect "127.0.0.1" (show privatePort) $ \(sPrivate, addr) -> spliceSockets sPublic sPrivate - -And to demonstrate that the sockets we deal with are just regular, normal -network sockets, we implement a function using the `splice` package that -creates a bidirectional pipe between the public and private sockets. - -> spliceSockets sLhs sRhs = do -> hLhs <- socketToHandle sLhs ReadWriteMode -> hRhs <- socketToHandle sRhs ReadWriteMode -> _ <- forkIO $ Splice.splice 1024 (sLhs, Just hLhs) (sRhs, Just hRhs) -> Splice.splice 1024 (sRhs, Just hRhs) (sLhs, Just hLhs) +> import System.Environment (getArgs)+> import Control.Concurrent (threadDelay, forkIO)+> import Control.Monad (void)+> import System.IO (IOMode (ReadWriteMode))++> import Network (withSocketsDo)+> import qualified Network.Simple.TCP as NST+> import Network.Socket (socketToHandle)+> import qualified Network.Socket.Splice as Splice++> import qualified Network.Anonymous.Tor as Tor++Our main function is fairly simple: get our configuration data and start+a new Tor Session. As soon as this session completes, exit the program.++> main = withSocketsDo $ do+> torPort <- whichControlPort+> portmap <- getPortmap++Once we got the configuration data, launch a Tor session and will continue+execution in the 'withinSession' function.++> Tor.withSession torPort (withinSession portmap)+>+> where++We need a simple function to detect which control port Tor listens at. By+default the Tor service uses port 9051, but the Tor Browser Bundle uses 9151,+to allow Tor and the TBB to run next to each other.++> whichControlPort = do+> let ports = [9051, 9151]+>+> availability <- mapM Tor.isAvailable ports++At this point, the `ports` list describes the list of ports in which we think+a Tor controller might be active, and `availability` has a list of the same length+with the associated availability status.++Since we're only interested in services that are available, we are going to+combine these list, filter on the availability status, and return the first port+that matches these constraints. This functionality is relatively unsafe, since+it assumes at least one Tor service is running (otherwise 'head' will return an+error).++> return . fst . head . filter ((== Tor.Available) . snd) $ zip ports availability++Some boilerplate code: we need to set up a port mapping, and rather than hard-+coding it, we allow the user to provide is as command line arguments. The first+argument is the public port we will listen at, the second argument the private+port we relay connections to.++> getPortmap :: IO (Integer, Integer)+> getPortmap = do+> [pub, priv] <- getArgs+> return (read pub, read priv)++Once a Tor session has been created and we are authenticated with the Tor+control service, let's set up a new onion service which redirects incoming+connections to the 'newConnection' function.++> withinSession (publicPort, privatePort) controlSock = do+> onion <- Tor.accept controlSock publicPort (newConnection privatePort)+> putStrLn ("hidden service descriptor: " ++ show onion)++If we would leave this function at this point, our connection with the Tor+control service would be lost, which would cause Tor to clean up any mappings+and hidden services we have registered.++Since this is just an example, we will now wait for 5 minutes and then exit.++> threadDelay 300000000++This function is called for all incoming connections. All it needs to do is+establish a connection with the local service and relay the connections to the+local, private server.++> newConnection privatePort sPublic =+> NST.connect "127.0.0.1" (show privatePort) $ \(sPrivate, addr) -> spliceSockets sPublic sPrivate++And to demonstrate that the sockets we deal with are just regular, normal+network sockets, we implement a function using the `splice` package that+creates a bidirectional pipe between the public and private sockets.++> spliceSockets sLhs sRhs = do+> hLhs <- socketToHandle sLhs ReadWriteMode+> hRhs <- socketToHandle sRhs ReadWriteMode+> _ <- forkIO $ Splice.splice 1024 (sLhs, Just hLhs) (sRhs, Just hRhs)+> Splice.splice 1024 (sRhs, Just hRhs) (sLhs, Just hLhs)
network-anonymous-tor.cabal view
@@ -1,95 +1,95 @@-name: network-anonymous-tor -category: Network -version: 0.9.2 -license: MIT -license-file: LICENSE -copyright: (c) 2014 Leon Mergen -author: Leon Mergen -maintainer: leon@solatis.com -stability: experimental -synopsis: Haskell API for Tor anonymous networking -description: - This library providess an API that wraps around the Tor control port - to create ad-hoc hidden services -homepage: http://www.leonmergen.com/opensource.html -build-type: Simple -data-files: LICENSE, README.md -cabal-version: >= 1.10 -tested-with: GHC == 7.6, GHC == 7.8, GHC == 7.10 - -library - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall -ferror-spans -auto-all -caf-all - - exposed-modules: Network.Anonymous.Tor - Network.Anonymous.Tor.Error - Network.Anonymous.Tor.Protocol - Network.Anonymous.Tor.Protocol.Types - Network.Anonymous.Tor.Protocol.Parser - Network.Anonymous.Tor.Protocol.Parser.Ast - - build-depends: base >= 4.3 && < 5 - , transformers - - , network - , network-simple - , socks - - , attoparsec - , network-attoparsec - , exceptions - , hexstring - , base32string - - , text - , bytestring - -test-suite test-suite - type: exitcode-stdio-1.0 - default-language: Haskell2010 - hs-source-dirs: test - main-is: Main.hs - ghc-options: -Wall -ferror-spans -threaded -auto-all -caf-all -fno-warn-type-defaults - - other-modules: Spec - Main - - build-depends: base >= 4.3 && < 5 - , exceptions - , transformers - - , network - , network-simple - , socks - - , attoparsec - , bytestring - , base32string - , text - - , hspec - , hspec-attoparsec - , hspec-expectations - - , network-anonymous-tor - -executable tor-relay - default-language: Haskell2010 - hs-source-dirs: examples - main-is: Relay.lhs - - build-depends: base >= 4.3 && < 5 - , exceptions - - , network - , network-simple - , splice - - , network-anonymous-tor - - -source-repository head - type: git - location: git://github.com/solatis/haskell-network-anonymous-tor.git - branch: master +name: network-anonymous-tor+category: Network+version: 0.10.0+license: MIT+license-file: LICENSE+copyright: (c) 2014 Leon Mergen+author: Leon Mergen+maintainer: leon@solatis.com+stability: experimental+synopsis: Haskell API for Tor anonymous networking+description:+ This library providess an API that wraps around the Tor control port+ to create ad-hoc hidden services+homepage: http://www.leonmergen.com/opensource.html+build-type: Simple+data-files: LICENSE, README.md+cabal-version: >= 1.10+tested-with: GHC == 7.6, GHC == 7.8, GHC == 7.10++library+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall -ferror-spans -auto-all -caf-all++ exposed-modules: Network.Anonymous.Tor+ Network.Anonymous.Tor.Error+ Network.Anonymous.Tor.Protocol+ Network.Anonymous.Tor.Protocol.Types+ Network.Anonymous.Tor.Protocol.Parser+ Network.Anonymous.Tor.Protocol.Parser.Ast++ build-depends: base >= 4.3 && < 5+ , transformers+ + , network+ , network-simple+ , socks++ , attoparsec+ , network-attoparsec+ , exceptions+ , hexstring+ , base32string++ , text+ , bytestring++test-suite test-suite+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs+ ghc-options: -Wall -ferror-spans -threaded -auto-all -caf-all -fno-warn-type-defaults++ other-modules: Spec+ Main++ build-depends: base >= 4.3 && < 5+ , exceptions+ , transformers ++ , network+ , network-simple+ , socks+ + , attoparsec+ , bytestring+ , base32string+ , text++ , hspec+ , hspec-attoparsec+ , hspec-expectations++ , network-anonymous-tor++executable tor-relay+ default-language: Haskell2010+ hs-source-dirs: examples+ main-is: Relay.lhs+ + build-depends: base >= 4.3 && < 5+ , exceptions++ , network+ , network-simple+ , splice+ + , network-anonymous-tor+ + +source-repository head+ type: git+ location: git://github.com/solatis/haskell-network-anonymous-tor.git+ branch: master
src/Network/Anonymous/Tor.hs view
@@ -1,179 +1,179 @@-{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} - --- | This module provides the main interface for establishing secure and --- anonymous connections with other hosts on the interface using the --- Tor project. For more information about the Tor network, see: --- <https://www.torproject.org/ torproject.org> --- -module Network.Anonymous.Tor ( - -- * Introduction to Tor - -- $tor-introduction - - -- * Client side - -- $tor-client - P.connect - , P.connect' - - -- * Server side - -- $tor-server - , P.mapOnion - , accept - - -- * Probing Tor configuration information - , P.Availability (..) - , P.isAvailable - , P.socksPort - - -- ** Setting up the context - , withSession - - ) where - -import Control.Concurrent (forkIO, threadDelay) -import Control.Monad.IO.Class - -import qualified Data.Base32String.Default as B32 - -import qualified Network.Simple.TCP as NST -import qualified Network.Socket as Network - -import qualified Network.Anonymous.Tor.Protocol as P - - --------------------------------------------------------------------------------- --- $tor-introduction --- --- This module is a (partial) implementation of the Tor control protocol. Tor is an --- internet anonimization network. Whereas historically, Tor is primarily --- intended for privately browsing the world wide web, the service also supports --- application oriented P2P communication, to implement communication between applications. --- --- The general idea of the Tor control interface to Tor is that you establish a master --- connection with the Tor control port, and create new, short-lived connections with --- the Tor bridge for the communication with the individual peers. --- --------------------------------------------------------------------------------- --- $tor-client --- --- == Connect through Tor with explicit port --- Connect through Tor on using a specified SOCKS port. Note that you do not --- need to authorize with the Tor control port for this functionality. --- --- @ --- main = 'connect' 9050 constructDestination worker --- --- where --- constructDestination = --- 'SocksT.SocksAddress' (SocksT.SocksAddrDomainName (BS8.pack "www.google.com")) 80 --- --- worker sock = --- -- Now you may use sock to communicate with the remote. --- return () --- @ --- --- == Connect through Tor using control port --- Connect through Tor and derive the SOCKS port from the Tor configuration. This --- function will query the Tor control service to find out which SOCKS port the --- Tor daemon listens at. --- --- @ --- main = 'withSession' withinSession --- --- where --- constructDestination = --- 'SocksT.SocksAddress' (SocksT.SocksAddrDomainName (BS8.pack "2a3b4c.onion")) 80 --- --- withinSession :: 'Network.Socket' -> IO () --- withinSession sock = do --- 'connect'' sock constructDestination worker --- --- worker sock = --- -- Now you may use sock to communicate with the remote. --- return () --- @ --- --------------------------------------------------------------------------------- --- $tor-server --- --- == Mapping --- Create a new hidden service, and map remote port 80 to local port 8080. --- --- @ --- main = 'withSession' withinSession --- --- where --- withinSession :: 'Network.Socket' -> IO () --- withinSession sock = do --- onion <- 'mapOnion' sock 80 8080 --- -- At this point, 'onion' contains the base32 representation of --- -- our hidden service, without the trailing '.onion' part. --- -- --- -- Remember that, once we leave this function, the connection with --- -- the Tor control service will be lost and any mappings will be --- -- cleaned up. --- @ --- --- == Server --- Convenience function which creates a hidden service on port 80 that is mapped --- to a server we create on the fly. Note that because we are mapping the hidden --- service's port 1:1 with our local port, port 80 must still be available. --- --- @ --- main = 'withSession' withinSession --- --- where --- withinSession :: 'Network.Socket' -> IO () --- withinSession sock = do --- onion <- 'accept' sock 80 worker --- -- At this point, 'onion' contains the base32 representation of --- -- our hidden service, without the trailing '.onion' part, and any --- -- incoming connections will be redirected to our 'worker' function. --- -- --- -- Once again, when we leave this function, all registered mappings --- -- will be lost. --- --- worker sock = do --- -- Now you may use sock to communicate with the remote. --- return () --- @ --------------------------------------------------------------------------------- - --- | Establishes a connection and authenticates with the Tor control socket. --- After authorization has been succesfully completed it executes the callback --- provided. --- --- Note that when the session completes, the connection with the Tor control --- port is dropped, which means that any port mappings, connections and hidden --- services you have registered within the session will be cleaned up. This --- is by design, to prevent stale mappings when an application crashes. - -withSession :: Integer -- ^ Port the Tor control server is listening at. Use - -- 'detectPort' to probe possible ports. - -> (Network.Socket -> IO a) -- ^ Callback function called after a session has been - -- established succesfully. - -> IO a -- ^ Returns the value returned by the callback. -withSession port callback = - NST.connect "127.0.0.1" (show port) (\(sock, _) -> do - _ <- P.authenticate sock - callback sock) - --- | Convenience function that creates a new hidden service and starts accepting --- connections for it. Note that this creates a new local server at the same --- port as the public port, so ensure that the port is not yet in use. -accept :: MonadIO m - => Network.Socket -- ^ Connection with Tor control server - -> Integer -- ^ Port to listen at - -> (Network.Socket -> IO ()) -- ^ Callback function called for each incoming connection - -> m B32.Base32String -- ^ Returns the hidden service descriptor created - -- without the '.onion' part. -accept sock port callback = do - -- First create local service - _ <- liftIO $ forkIO $ - NST.listen "*" (show port) (\(lsock, _) -> - NST.accept lsock (\(csock, _) -> do - _ <- callback csock - threadDelay 1000000 - return ())) - - P.mapOnion sock port port +{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}++-- | This module provides the main interface for establishing secure and+-- anonymous connections with other hosts on the interface using the+-- Tor project. For more information about the Tor network, see:+-- <https://www.torproject.org/ torproject.org>+--+module Network.Anonymous.Tor (+ -- * Introduction to Tor+ -- $tor-introduction++ -- * Client side+ -- $tor-client+ P.connect+ , P.connect'++ -- * Server side+ -- $tor-server+ , P.mapOnion+ , accept++ -- * Probing Tor configuration information+ , P.Availability (..)+ , P.isAvailable+ , P.socksPort++ -- ** Setting up the context+ , withSession++ ) where++import Control.Concurrent (forkIO, threadDelay)+import Control.Monad.IO.Class++import qualified Data.Base32String.Default as B32++import qualified Network.Simple.TCP as NST+import qualified Network.Socket as Network++import qualified Network.Anonymous.Tor.Protocol as P+++--------------------------------------------------------------------------------+-- $tor-introduction+--+-- This module is a (partial) implementation of the Tor control protocol. Tor is an+-- internet anonimization network. Whereas historically, Tor is primarily+-- intended for privately browsing the world wide web, the service also supports+-- application oriented P2P communication, to implement communication between applications.+--+-- The general idea of the Tor control interface to Tor is that you establish a master+-- connection with the Tor control port, and create new, short-lived connections with+-- the Tor bridge for the communication with the individual peers.+--+--------------------------------------------------------------------------------+-- $tor-client+--+-- == Connect through Tor with explicit port+-- Connect through Tor on using a specified SOCKS port. Note that you do not+-- need to authorize with the Tor control port for this functionality.+--+-- @+-- main = 'connect' 9050 constructDestination worker+--+-- where+-- constructDestination =+-- 'SocksT.SocksAddress' (SocksT.SocksAddrDomainName (BS8.pack "www.google.com")) 80+--+-- worker sock =+-- -- Now you may use sock to communicate with the remote.+-- return ()+-- @+--+-- == Connect through Tor using control port+-- Connect through Tor and derive the SOCKS port from the Tor configuration. This+-- function will query the Tor control service to find out which SOCKS port the+-- Tor daemon listens at.+--+-- @+-- main = 'withSession' withinSession+--+-- where+-- constructDestination =+-- 'SocksT.SocksAddress' (SocksT.SocksAddrDomainName (BS8.pack "2a3b4c.onion")) 80+--+-- withinSession :: 'Network.Socket' -> IO ()+-- withinSession sock = do+-- 'connect'' sock constructDestination worker+--+-- worker sock =+-- -- Now you may use sock to communicate with the remote.+-- return ()+-- @+--+--------------------------------------------------------------------------------+-- $tor-server+--+-- == Mapping+-- Create a new hidden service, and map remote port 80 to local port 8080.+--+-- @+-- main = 'withSession' withinSession+--+-- where+-- withinSession :: 'Network.Socket' -> IO ()+-- withinSession sock = do+-- onion <- 'mapOnion' sock 80 8080+-- -- At this point, 'onion' contains the base32 representation of+-- -- our hidden service, without the trailing '.onion' part.+-- --+-- -- Remember that, once we leave this function, the connection with+-- -- the Tor control service will be lost and any mappings will be+-- -- cleaned up.+-- @+--+-- == Server+-- Convenience function which creates a hidden service on port 80 that is mapped+-- to a server we create on the fly. Note that because we are mapping the hidden+-- service's port 1:1 with our local port, port 80 must still be available.+--+-- @+-- main = 'withSession' withinSession+--+-- where+-- withinSession :: 'Network.Socket' -> IO ()+-- withinSession sock = do+-- onion <- 'accept' sock 80 worker+-- -- At this point, 'onion' contains the base32 representation of+-- -- our hidden service, without the trailing '.onion' part, and any+-- -- incoming connections will be redirected to our 'worker' function.+-- --+-- -- Once again, when we leave this function, all registered mappings+-- -- will be lost.+--+-- worker sock = do+-- -- Now you may use sock to communicate with the remote.+-- return ()+-- @+--------------------------------------------------------------------------------++-- | Establishes a connection and authenticates with the Tor control socket.+-- After authorization has been succesfully completed it executes the callback+-- provided.+--+-- Note that when the session completes, the connection with the Tor control+-- port is dropped, which means that any port mappings, connections and hidden+-- services you have registered within the session will be cleaned up. This+-- is by design, to prevent stale mappings when an application crashes.++withSession :: Integer -- ^ Port the Tor control server is listening at. Use+ -- 'detectPort' to probe possible ports.+ -> (Network.Socket -> IO a) -- ^ Callback function called after a session has been+ -- established succesfully.+ -> IO a -- ^ Returns the value returned by the callback.+withSession port callback =+ NST.connect "127.0.0.1" (show port) (\(sock, _) -> do+ _ <- P.authenticate sock+ callback sock)++-- | Convenience function that creates a new hidden service and starts accepting+-- connections for it. Note that this creates a new local server at the same+-- port as the public port, so ensure that the port is not yet in use.+accept :: MonadIO m+ => Network.Socket -- ^ Connection with Tor control server+ -> Integer -- ^ Port to listen at+ -> (Network.Socket -> IO ()) -- ^ Callback function called for each incoming connection+ -> m B32.Base32String -- ^ Returns the hidden service descriptor created+ -- without the '.onion' part.+accept sock port callback = do+ -- First create local service+ _ <- liftIO $ forkIO $+ NST.listen "*" (show port) (\(lsock, _) ->+ NST.accept lsock (\(csock, _) -> do+ _ <- callback csock+ threadDelay 1000000+ return ()))++ P.mapOnion sock port port
src/Network/Anonymous/Tor/Error.hs view
@@ -1,63 +1,63 @@-{-# LANGUAGE DeriveDataTypeable #-} - --- | Tor error types, inspired by System.IO.Error -module Network.Anonymous.Tor.Error where - -import Data.Typeable (Typeable) - -import Control.Monad.IO.Class -import Control.Exception (throwIO) -import Control.Exception.Base (Exception) - --- | Error type used -type TorError = TorException - --- | Exception that we use to throw. It is the only type of exception --- we throw, and the type of error is embedded within the exception. -data TorException = TorError { - toreType :: TorErrorType -- ^ Our error type - } deriving (Show, Eq, Typeable) - --- | Derives our Tor exception from the standard exception, which opens it --- up to being used with all the regular try/catch/bracket/etc functions. -instance Exception TorException - --- | An abstract type that contains a value for each variant of 'TorError' -data TorErrorType - = Timeout - | Unreachable - | ProtocolError - | PermissionDenied - deriving (Show, Eq) - --- | Generates new TorException -mkTorError :: TorErrorType -> TorError -mkTorError t = TorError { toreType = t } - --- | Tor error when a timeout has occurred -timeoutErrorType :: TorErrorType -timeoutErrorType = Timeout - --- | Tor error when a host was unreachable -unreachableErrorType :: TorErrorType -unreachableErrorType = Unreachable - --- | Tor error when communication with the SAM bridge fails -protocolErrorType :: TorErrorType -protocolErrorType = ProtocolError - --- | Tor error when communication with the SAM bridge fails -permissionDeniedErrorType :: TorErrorType -permissionDeniedErrorType = PermissionDenied - --- | Raise an Tor Exception in the IO monad -torException :: (MonadIO m) - => TorException - -> m a -torException = liftIO . throwIO - --- | Raise an Tor error in the IO monad -torError :: (MonadIO m) - => TorError - -> m a -torError = torException +{-# LANGUAGE DeriveDataTypeable #-}++-- | Tor error types, inspired by System.IO.Error+module Network.Anonymous.Tor.Error where++import Data.Typeable (Typeable)++import Control.Monad.IO.Class+import Control.Exception (throwIO)+import Control.Exception.Base (Exception)++-- | Error type used+type TorError = TorException++-- | Exception that we use to throw. It is the only type of exception+-- we throw, and the type of error is embedded within the exception.+data TorException = TorError {+ toreType :: TorErrorType -- ^ Our error type+ } deriving (Show, Eq, Typeable)++-- | Derives our Tor exception from the standard exception, which opens it+-- up to being used with all the regular try/catch/bracket/etc functions.+instance Exception TorException++-- | An abstract type that contains a value for each variant of 'TorError'+data TorErrorType+ = Timeout+ | Unreachable+ | ProtocolError String+ | PermissionDenied String+ deriving (Show, Eq)++-- | Generates new TorException+mkTorError :: TorErrorType -> TorError+mkTorError t = TorError { toreType = t }++-- | Tor error when a timeout has occurred+timeoutErrorType :: TorErrorType+timeoutErrorType = Timeout++-- | Tor error when a host was unreachable+unreachableErrorType :: TorErrorType+unreachableErrorType = Unreachable++-- | Tor error when communication with the SAM bridge fails+protocolErrorType :: String -> TorErrorType+protocolErrorType = ProtocolError++-- | Tor error when communication with the SAM bridge fails+permissionDeniedErrorType :: String -> TorErrorType+permissionDeniedErrorType = PermissionDenied++-- | Raise an Tor Exception in the IO monad+torException :: (MonadIO m)+ => TorException+ -> m a+torException = liftIO . throwIO++-- | Raise an Tor error in the IO monad+torError :: (MonadIO m)+ => TorError+ -> m a+torError = torException
src/Network/Anonymous/Tor/Protocol.hs view
@@ -1,206 +1,247 @@-{-# LANGUAGE OverloadedStrings #-} - --- | Protocol description --- --- Defines functions that handle the advancing of the Tor control protocol. --- --- __Warning__: This function is used internally by 'Network.Anonymous.Tor' --- and using these functions directly is unsupported. The --- interface of these functions might change at any time without --- prior notice. --- -module Network.Anonymous.Tor.Protocol ( Availability (..) - , isAvailable - , socksPort - , connect - , connect' - , protocolInfo - , authenticate - , mapOnion ) where - -import Control.Concurrent.MVar - -import Control.Monad (unless, void, when) -import Control.Monad.Catch ( handle - , handleIOError ) -import Control.Monad.IO.Class - -import qualified System.IO.Error as E -import qualified GHC.IO.Exception as E hiding (ProtocolError) - -import qualified Data.Attoparsec.ByteString as Atto -import qualified Data.Base32String.Default as B32 -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS8 -import qualified Data.HexString as HS -import Data.Maybe (fromJust) - -import qualified Data.Text.Encoding as TE - -import qualified Network.Attoparsec as NA -import qualified Network.Simple.TCP as NST - -import qualified Network.Socket as Network hiding - (recv, - send) -import qualified Network.Socket.ByteString as Network -import qualified Network.Socks5 as Socks - -import qualified Network.Anonymous.Tor.Error as E -import qualified Network.Anonymous.Tor.Protocol.Parser as Parser -import qualified Network.Anonymous.Tor.Protocol.Parser.Ast as Ast -import qualified Network.Anonymous.Tor.Protocol.Types as T - -sendCommand :: MonadIO m - => Network.Socket -- ^ Our connection with the Tor control port - -> BS.ByteString -- ^ The command / instruction we wish to send - -> m [Ast.Line] -sendCommand sock = sendCommand' sock 250 E.protocolErrorType - -sendCommand' :: MonadIO m - => Network.Socket -- ^ Our connection with the Tor control port - -> Integer -- ^ The status code we expect - -> E.TorErrorType -- ^ The type of error to throw if status code doesn't match - -> BS.ByteString -- ^ The command / instruction we wish to send - -> m [Ast.Line] -sendCommand' sock status errorType msg = do - _ <- liftIO $ Network.sendAll sock msg - res <- liftIO $ NA.parseOne sock (Atto.parse Parser.reply) - - when (Ast.statusCode res /= status) - (E.torError (E.mkTorError errorType)) - - return res - --- | Represents the availability status of Tor for a specific port. -data Availability = - Available | -- ^ There is a Tor control service listening at the port - ConnectionRefused | -- ^ There is no service listening at the port - IncorrectPort -- ^ There is a non-Tor control service listening at the port - deriving (Show, Eq) - --- | Probes a port to see if there is a service at the remote that behaves --- like the Tor controller daemon. Will return the status of the probed --- port. -isAvailable :: MonadIO m - => Integer -- ^ The ports we wish to probe - -> m Availability -- ^ The status of all the ports -isAvailable port = liftIO $ do - - result <- newEmptyMVar - - handle (\(E.TorError E.ProtocolError) -> putMVar result IncorrectPort) - $ handleIOError (\e -> - -- The error raised for a Connection Refused is a very descriptive OtherError - if E.ioeGetErrorType e == E.OtherError || E.ioeGetErrorType e == E.NoSuchThing - then putMVar result ConnectionRefused - else E.ioError e) - (performTest port result) - - takeMVar result - - where - performTest port result = - NST.connect "127.0.0.1" (show port) (\(sock, _) -> do - _ <- protocolInfo sock - putMVar result Available) --- | Returns the configured SOCKS proxy port -socksPort :: MonadIO m - => Network.Socket - -> m Integer -socksPort s = do - reply <- sendCommand s (BS8.pack "GETCONF SOCKSPORT\n") - - return . fst . fromJust . BS8.readInteger . fromJust . Ast.tokenValue . head . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "SocksPort") reply - --- | Connect through a remote using the Tor SOCKS proxy. The remote might me a --- a normal host/ip or a hidden service address. When you provide a FQDN to --- resolve, it will be resolved by the Tor service, and as such is secure. --- --- This function is provided as a convenience, since it doesn't actually use --- the Tor control protocol, and can be used to talk with any Socks5 compatible --- proxy server. -connect :: MonadIO m - => Integer -- ^ Port our tor SOCKS server listens at. - -> Socks.SocksAddress -- ^ Address we wish to connect to - -> (Network.Socket -> IO a) -- ^ Computation to execute once connection has been establised - -> m a -connect sport remote callback = liftIO $ do - (sock, _) <- Socks.socksConnect conf remote - callback sock - - where - conf = Socks.defaultSocksConf "127.0.0.1" (fromInteger sport) - -connect' :: MonadIO m - => Network.Socket -- ^ Our connection with the Tor control port - -> Socks.SocksAddress -- ^ Address we wish to connect to - -> (Network.Socket -> IO a) -- ^ Computation to execute once connection has been establised - -> m a -connect' sock remote callback = do - sport <- socksPort sock - connect sport remote callback - --- | Requests protocol version information from Tor. This can be used while --- still unauthenticated and authentication methods can be derived from this --- information. -protocolInfo :: MonadIO m - => Network.Socket - -> m T.ProtocolInfo -protocolInfo s = do - res <- sendCommand s (BS.concat ["PROTOCOLINFO", "\n"]) - - return (T.ProtocolInfo (protocolVersion res) (torVersion res) (methods res) (cookieFile res)) - - where - - protocolVersion :: [Ast.Line] -> Integer - protocolVersion reply = - fst . fromJust . BS8.readInteger . Ast.tokenKey . last . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "PROTOCOLINFO") reply - - torVersion :: [Ast.Line] -> [Integer] - torVersion reply = - map (fst . fromJust . BS8.readInteger) . BS8.split '.' . fromJust . Ast.value "Tor" . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "VERSION") reply - - methods :: [Ast.Line] -> [T.AuthMethod] - methods reply = - map (read . BS8.unpack) . BS8.split ',' . fromJust . Ast.value "METHODS" . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "AUTH") reply - - cookieFile :: [Ast.Line] -> Maybe FilePath - cookieFile reply = - fmap BS8.unpack . Ast.value "COOKIEFILE" . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "AUTH") reply - --- | Authenticates with the Tor control server, based on the authentication --- information returned by PROTOCOLINFO. -authenticate :: MonadIO m - => Network.Socket - -> m () -authenticate s = do - info <- protocolInfo s - - -- Ensure that we can authenticate using a cookie file - unless (T.Cookie `elem` T.authMethods info) - (E.torError (E.mkTorError E.permissionDeniedErrorType)) - - cookieData <- liftIO $ readCookie (T.cookieFile info) - - liftIO . void $ sendCommand' s 250 E.permissionDeniedErrorType (BS8.concat ["AUTHENTICATE ", TE.encodeUtf8 $ HS.toText cookieData, "\n"]) - - where - - readCookie :: Maybe FilePath -> IO HS.HexString - readCookie Nothing = E.torError (E.mkTorError E.protocolErrorType) - readCookie (Just file) = return . HS.fromBytes =<< BS.readFile file - --- | Creates a new hidden service and maps a public port to a local port. Useful --- for bridging a local service (e.g. a webserver or irc daemon) as a Tor --- hidden service. -mapOnion :: MonadIO m - => Network.Socket -- ^ Connection with tor Control port - -> Integer -- ^ Remote point of hidden service to listen at - -> Integer -- ^ Local port to map onion service to - -> m B32.Base32String -- ^ The address/service id of the Onion without the .onion aprt -mapOnion s rport lport = do - reply <- sendCommand s (BS8.concat ["ADD_ONION NEW:BEST Port=", BS8.pack (show rport), ",127.0.0.1:", BS8.pack(show lport), "\n"]) - - return . B32.b32String' . fromJust . Ast.tokenValue . head . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "ServiceID") reply +{-# LANGUAGE OverloadedStrings #-}++-- | Protocol description+--+-- Defines functions that handle the advancing of the Tor control protocol.+--+-- __Warning__: This function is used internally by 'Network.Anonymous.Tor'+-- and using these functions directly is unsupported. The+-- interface of these functions might change at any time without+-- prior notice.+--+module Network.Anonymous.Tor.Protocol ( Availability (..)+ , isAvailable+ , socksPort+ , connect+ , connect'+ , protocolInfo+ , authenticate+ , mapOnion ) where++import Control.Concurrent.MVar++import Control.Monad (unless, void, when)+import Control.Monad.Catch ( handle+ , handleIOError )+import Control.Monad.IO.Class++import qualified System.IO.Error as E+import qualified GHC.IO.Exception as E hiding (ProtocolError)++import qualified Data.Attoparsec.ByteString as Atto+import qualified Data.Base32String.Default as B32+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.HexString as HS+import Data.Maybe (fromJust)++import qualified Data.Text.Encoding as TE++import qualified Network.Attoparsec as NA+import qualified Network.Simple.TCP as NST++import qualified Network.Socket as Network hiding+ (recv,+ send)+import qualified Network.Socket.ByteString as Network+import qualified Network.Socks5 as Socks++import qualified Network.Anonymous.Tor.Error as E+import qualified Network.Anonymous.Tor.Protocol.Parser as Parser+import qualified Network.Anonymous.Tor.Protocol.Parser.Ast as Ast+import qualified Network.Anonymous.Tor.Protocol.Types as T++sendCommand :: MonadIO m+ => Network.Socket -- ^ Our connection with the Tor control port+ -> BS.ByteString -- ^ The command / instruction we wish to send+ -> m [Ast.Line]+sendCommand sock = sendCommand' sock errorF+ where++ errorF :: Ast.Line -> Maybe E.TorErrorType+ errorF (Ast.Line 250 _ ) = Nothing+ errorF (Ast.Line c tokens) = let message = toMessage tokens+ code = codeName c+ err = show c ++ " " ++ code ++ ": " ++ message+ in Just . E.protocolErrorType $ err++ toMessage :: [Ast.Token] -> String+ toMessage = unwords . map extract++ extract :: Ast.Token -> String+ extract (Ast.Token s Nothing ) = BS8.unpack s+ extract (Ast.Token k (Just v)) = BS8.unpack k ++ "=" ++ BS8.unpack v++ codeName :: Integer -> String+ codeName 250 = "OK"+ codeName 251 = "Operation was unnecessary"+ codeName 451 = "Ressource exhausted"+ codeName 500 = "Syntax error: protocol"+ codeName 510 = "Unrecognized command"+ codeName 511 = "Unimplemented command"+ codeName 512 = "Syntax error in command argument"+ codeName 513 = "Unrecognized command argument"+ codeName 514 = "Authentication required"+ codeName 550 = "Unspecified Tor error"+ codeName 551 = "Internal error"+ codeName 552 = "Unrecognized entity"+ codeName 553 = "Invalid configuration value"+ codeName 554 = "Invalid descriptor"+ codeName 555 = "Unmanaged entity"+ codeName 650 = "Asynchrounous event notification"+ codeName _ = "Unrecognized status code"++sendCommand' :: MonadIO m+ => Network.Socket -- ^ Our connection with the Tor control port+ -> (Ast.Line -> Maybe E.TorErrorType) -- ^ A function using the first line of the response to determine wether to throw an error+ -> BS.ByteString -- ^ The command / instruction we wish to send+ -> m [Ast.Line]+sendCommand' sock errorF msg = do+ _ <- liftIO $ Network.sendAll sock msg+ res <- liftIO $ NA.parseOne sock (Atto.parse Parser.reply)++ case errorF . head $ res of+ Just e -> E.torError (E.mkTorError e)+ _ -> return ()++ return res++-- | Represents the availability status of Tor for a specific port.+data Availability =+ Available | -- ^ There is a Tor control service listening at the port+ ConnectionRefused | -- ^ There is no service listening at the port+ IncorrectPort -- ^ There is a non-Tor control service listening at the port+ deriving (Show, Eq)++-- | Probes a port to see if there is a service at the remote that behaves+-- like the Tor controller daemon. Will return the status of the probed+-- port.+isAvailable :: MonadIO m+ => Integer -- ^ The ports we wish to probe+ -> m Availability -- ^ The status of all the ports+isAvailable port = liftIO $ do++ result <- newEmptyMVar++ handle (\(E.TorError (E.ProtocolError _)) -> putMVar result IncorrectPort)+ $ handleIOError (\e ->+ -- The error raised for a Connection Refused is a very descriptive OtherError+ if E.ioeGetErrorType e == E.OtherError || E.ioeGetErrorType e == E.NoSuchThing+ then putMVar result ConnectionRefused+ else if E.ioeGetErrorType e == E.UserError -- This gets thrown by network-attoparsec+ -- when there is a parse error.+ then putMVar result IncorrectPort+ else E.ioError e)+ (performTest port result)++ takeMVar result++ where+ performTest port result =+ NST.connect "127.0.0.1" (show port) (\(sock, _) -> do+ _ <- protocolInfo sock+ putMVar result Available)+-- | Returns the configured SOCKS proxy port+socksPort :: MonadIO m+ => Network.Socket+ -> m Integer+socksPort s = do+ reply <- sendCommand s (BS8.pack "GETCONF SOCKSPORT\n")++ return . fst . fromJust . BS8.readInteger . fromJust . Ast.tokenValue . head . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "SocksPort") reply++-- | Connect through a remote using the Tor SOCKS proxy. The remote might me a+-- a normal host/ip or a hidden service address. When you provide a FQDN to+-- resolve, it will be resolved by the Tor service, and as such is secure.+--+-- This function is provided as a convenience, since it doesn't actually use+-- the Tor control protocol, and can be used to talk with any Socks5 compatible+-- proxy server.+connect :: MonadIO m+ => Integer -- ^ Port our tor SOCKS server listens at.+ -> Socks.SocksAddress -- ^ Address we wish to connect to+ -> (Network.Socket -> IO a) -- ^ Computation to execute once connection has been establised+ -> m a+connect sport remote callback = liftIO $ do+ (sock, _) <- Socks.socksConnect conf remote+ callback sock++ where+ conf = Socks.defaultSocksConf "127.0.0.1" (fromInteger sport)++connect' :: MonadIO m+ => Network.Socket -- ^ Our connection with the Tor control port+ -> Socks.SocksAddress -- ^ Address we wish to connect to+ -> (Network.Socket -> IO a) -- ^ Computation to execute once connection has been establised+ -> m a+connect' sock remote callback = do+ sport <- socksPort sock+ connect sport remote callback++-- | Requests protocol version information from Tor. This can be used while+-- still unauthenticated and authentication methods can be derived from this+-- information.+protocolInfo :: MonadIO m+ => Network.Socket+ -> m T.ProtocolInfo+protocolInfo s = do+ res <- sendCommand s (BS.concat ["PROTOCOLINFO", "\n"])++ return (T.ProtocolInfo (protocolVersion res) (torVersion res) (methods res) (cookieFile res))++ where++ protocolVersion :: [Ast.Line] -> Integer+ protocolVersion reply =+ fst . fromJust . BS8.readInteger . Ast.tokenKey . last . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "PROTOCOLINFO") reply++ torVersion :: [Ast.Line] -> [Integer]+ torVersion reply =+ map (fst . fromJust . BS8.readInteger) . BS8.split '.' . fromJust . Ast.value "Tor" . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "VERSION") reply++ methods :: [Ast.Line] -> [T.AuthMethod]+ methods reply =+ map (read . BS8.unpack) . BS8.split ',' . fromJust . Ast.value "METHODS" . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "AUTH") reply++ cookieFile :: [Ast.Line] -> Maybe FilePath+ cookieFile reply =+ fmap BS8.unpack . Ast.value "COOKIEFILE" . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "AUTH") reply++-- | Authenticates with the Tor control server, based on the authentication+-- information returned by PROTOCOLINFO.+authenticate :: MonadIO m+ => Network.Socket+ -> m ()+authenticate s = do+ info <- protocolInfo s++ -- Ensure that we can authenticate using a cookie file+ unless (T.Cookie `elem` T.authMethods info)+ (E.torError (E.mkTorError . E.permissionDeniedErrorType $ "Authentication via cookie file disabled."))++ cookieData <- liftIO $ readCookie (T.cookieFile info)++ liftIO . void $ sendCommand' s errorF (BS8.concat ["AUTHENTICATE ", TE.encodeUtf8 $ HS.toText cookieData, "\n"])++ where++ readCookie :: Maybe FilePath -> IO HS.HexString+ readCookie Nothing = E.torError (E.mkTorError . E.protocolErrorType $ "No cookie path specified.")+ readCookie (Just file) = return . HS.fromBytes =<< BS.readFile file++ errorF :: Ast.Line -> Maybe E.TorErrorType+ errorF (Ast.Line 250 _) = Nothing+ errorF _ = Just . E.permissionDeniedErrorType $ "Authentication failed."++-- | Creates a new hidden service and maps a public port to a local port. Useful+-- for bridging a local service (e.g. a webserver or irc daemon) as a Tor+-- hidden service.+mapOnion :: MonadIO m+ => Network.Socket -- ^ Connection with tor Control port+ -> Integer -- ^ Remote point of hidden service to listen at+ -> Integer -- ^ Local port to map onion service to+ -> m B32.Base32String -- ^ The address/service id of the Onion without the .onion aprt+mapOnion s rport lport = do+ reply <- sendCommand s (BS8.concat ["ADD_ONION NEW:BEST Port=", BS8.pack (show rport), ",127.0.0.1:", BS8.pack(show lport), "\n"])++ return . B32.b32String' . fromJust . Ast.tokenValue . head . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "ServiceID") reply
src/Network/Anonymous/Tor/Protocol/Parser.hs view
@@ -1,135 +1,135 @@--- | Parser defintions --- --- Defines parsers used by the Tor Control protocol --- --- __Warning__: This function is used internally by 'Network.Anonymous.Tor' --- and using these functions directly is unsupported. The --- interface of these functions might change at any time without --- prior notice. --- - -module Network.Anonymous.Tor.Protocol.Parser ( quotedString - , unquotedString - , reply - , key - , keyValue - , value - , token - , tokens ) where - -import Control.Applicative ((*>), (<$>), (<*), (<*>), - (<|>)) - -import qualified Data.Attoparsec.ByteString as Atto -import qualified Data.Attoparsec.ByteString.Char8 as Atto8 -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS8 -import Data.Word (Word8) -import qualified Network.Anonymous.Tor.Protocol.Parser.Ast as A - --- | Ascii offset representation of a double quote. -doubleQuote :: Word8 -doubleQuote = 34 - --- | Ascii offset representation of a single quote. -singleQuote :: Word8 -singleQuote = 39 - --- | Ascii offset representation of a backslash. -backslash :: Word8 -backslash = 92 - --- | Ascii offset representation of a minus '-' symbol -minus :: Word8 -minus = 45 - --- | Ascii offset representation of a plus '+' symbol -plus :: Word8 -plus = 43 - --- | Ascii offset representation of a space ' ' character -space :: Word8 -space = 32 - --- | Ascii offset representation of an equality sign. -equals :: Word8 -equals = 61 - --- | Parses a single- or double-quoted string, and returns all bytes within the --- value; the unescaping is beyond the scope of this function (since different --- unescaping mechanisms might be desired). -quotedString :: Atto.Parser BS.ByteString -quotedString = - let quoted :: Word8 -- ^ The character used for quoting - -> Atto.Parser BS.ByteString -- ^ The value inside the quotes, without the surrounding quotes - quoted c = (Atto.word8 c *> escaped c <* Atto.word8 c) - - -- | Parses an escaped string, with an arbitrary surrounding quote type. - escaped :: Word8 -> Atto.Parser BS.ByteString - escaped c = BS8.concat <$> Atto8.many' - -- Make sure that we eat pairs of backslashes; this will make sure - -- that a string such as "\\\\" is interpreted correctly, and the - -- ending quoted will not be interpreted as escaped. - ( Atto8.string (BS8.pack "\\\\") - - -- This eats all escaped quotes and leaves them in tact; the unescaping - -- is beyond the scope of this function. - <|> Atto8.string (BS.pack [backslash, c]) - - -- And for the rest: eat everything that is not a quote. - <|> (BS.singleton <$> Atto.satisfy (/= c))) - - in quoted doubleQuote <|> quoted singleQuote - --- | An unquoted string is "everything until a whitespace or newline is reached". -unquotedString :: Atto.Parser BS.ByteString -unquotedString = - Atto8.takeWhile1 (not . Atto8.isSpace) - -reply :: Atto.Parser [A.Line] -reply = do - -- A reply is a series of lines that look like 250-Foo or 250+Bar and then - -- followed by a line that uses a space like 250 Wombat. - -- - -- Let's parse all these lines into a reply. - replies <- Atto.many' (replyLine minus <|> replyLine plus) - lastReply <- replyLine space - - return (replies ++ [lastReply]) - - where - replyLine :: Word8 -> Atto.Parser A.Line - replyLine c = A.Line <$> Atto8.decimal <*> (Atto.word8 c *> tokens) <* Atto8.endOfLine - --- | Parses either a quoted value or an unquoted value -value :: Atto.Parser BS.ByteString -value = - quotedString <|> unquotedString - --- | Parses key and value -keyValue :: Atto.Parser A.Token -keyValue = do - A.Token k _ <- key - _ <- Atto.word8 equals - v <- value - - return (A.Token k (Just v)) - --- | Parses a key, which is anything until either a space has been reached, or --- an '=' is reached. -key :: Atto.Parser A.Token -key = - let isKeyEnd '=' = True - isKeyEnd c = Atto8.isSpace c - - in flip A.Token Nothing <$> Atto8.takeWhile1 (not . isKeyEnd) - --- | A Token is either a Key or a Key/Value combination. -token :: Atto.Parser A.Token -token = - Atto.skipWhile Atto8.isHorizontalSpace *> (keyValue <|> key) - --- | Parser that reads keys or key/values -tokens :: Atto.Parser [A.Token] -tokens = - Atto.many' token +-- | Parser defintions+--+-- Defines parsers used by the Tor Control protocol+--+-- __Warning__: This function is used internally by 'Network.Anonymous.Tor'+-- and using these functions directly is unsupported. The+-- interface of these functions might change at any time without+-- prior notice.+--++module Network.Anonymous.Tor.Protocol.Parser ( quotedString+ , unquotedString+ , reply+ , key+ , keyValue+ , value+ , token+ , tokens ) where++import Control.Applicative ((*>), (<$>), (<*), (<*>),+ (<|>))++import qualified Data.Attoparsec.ByteString as Atto+import qualified Data.Attoparsec.ByteString.Char8 as Atto8+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.Word (Word8)+import qualified Network.Anonymous.Tor.Protocol.Parser.Ast as A++-- | Ascii offset representation of a double quote.+doubleQuote :: Word8+doubleQuote = 34++-- | Ascii offset representation of a single quote.+singleQuote :: Word8+singleQuote = 39++-- | Ascii offset representation of a backslash.+backslash :: Word8+backslash = 92++-- | Ascii offset representation of a minus '-' symbol+minus :: Word8+minus = 45++-- | Ascii offset representation of a plus '+' symbol+plus :: Word8+plus = 43++-- | Ascii offset representation of a space ' ' character+space :: Word8+space = 32++-- | Ascii offset representation of an equality sign.+equals :: Word8+equals = 61++-- | Parses a single- or double-quoted string, and returns all bytes within the+-- value; the unescaping is beyond the scope of this function (since different+-- unescaping mechanisms might be desired).+quotedString :: Atto.Parser BS.ByteString+quotedString =+ let quoted :: Word8 -- ^ The character used for quoting+ -> Atto.Parser BS.ByteString -- ^ The value inside the quotes, without the surrounding quotes+ quoted c = (Atto.word8 c *> escaped c <* Atto.word8 c)++ -- | Parses an escaped string, with an arbitrary surrounding quote type.+ escaped :: Word8 -> Atto.Parser BS.ByteString+ escaped c = BS8.concat <$> Atto8.many'+ -- Make sure that we eat pairs of backslashes; this will make sure+ -- that a string such as "\\\\" is interpreted correctly, and the+ -- ending quoted will not be interpreted as escaped.+ ( Atto8.string (BS8.pack "\\\\")++ -- This eats all escaped quotes and leaves them in tact; the unescaping+ -- is beyond the scope of this function.+ <|> Atto8.string (BS.pack [backslash, c])++ -- And for the rest: eat everything that is not a quote.+ <|> (BS.singleton <$> Atto.satisfy (/= c)))++ in quoted doubleQuote <|> quoted singleQuote++-- | An unquoted string is "everything until a whitespace or newline is reached".+unquotedString :: Atto.Parser BS.ByteString+unquotedString =+ Atto8.takeWhile1 (not . Atto8.isSpace)++reply :: Atto.Parser [A.Line]+reply = do+ -- A reply is a series of lines that look like 250-Foo or 250+Bar and then+ -- followed by a line that uses a space like 250 Wombat.+ --+ -- Let's parse all these lines into a reply.+ replies <- Atto.many' (replyLine minus <|> replyLine plus)+ lastReply <- replyLine space++ return (replies ++ [lastReply])++ where+ replyLine :: Word8 -> Atto.Parser A.Line+ replyLine c = A.Line <$> Atto8.decimal <*> (Atto.word8 c *> tokens) <* Atto8.endOfLine++-- | Parses either a quoted value or an unquoted value+value :: Atto.Parser BS.ByteString+value =+ quotedString <|> unquotedString++-- | Parses key and value+keyValue :: Atto.Parser A.Token+keyValue = do+ A.Token k _ <- key+ _ <- Atto.word8 equals+ v <- value++ return (A.Token k (Just v))++-- | Parses a key, which is anything until either a space has been reached, or+-- an '=' is reached.+key :: Atto.Parser A.Token+key =+ let isKeyEnd '=' = True+ isKeyEnd c = Atto8.isSpace c++ in flip A.Token Nothing <$> Atto8.takeWhile1 (not . isKeyEnd)++-- | A Token is either a Key or a Key/Value combination.+token :: Atto.Parser A.Token+token =+ Atto.skipWhile Atto8.isHorizontalSpace *> (keyValue <|> key)++-- | Parser that reads keys or key/values+tokens :: Atto.Parser [A.Token]+tokens =+ Atto.many' token
src/Network/Anonymous/Tor/Protocol/Parser/Ast.hs view
@@ -1,74 +1,74 @@--- | Abstract syntax tree used by the 'Parser', including helper functions --- for traversing the tree. --- --- __Warning__: This function is used internally by 'Network.Anonymous.Tor' --- and using these functions directly is unsupported. The --- interface of these functions might change at any time without --- prior notice. --- - -module Network.Anonymous.Tor.Protocol.Parser.Ast where -import qualified Data.Attoparsec.ByteString as Atto - -import qualified Data.ByteString as BS - --- | A token is a key and can maybe have an associated value -data Token = Token { - tokenKey :: BS.ByteString, - tokenValue :: Maybe BS.ByteString - } deriving (Show, Eq) - --- | A line is just a sequence of tokens -- the 'Parser' ends the chain --- when a newline is received. -data Line = Line { - lineStatusCode :: Integer, - lineMessage :: [Token] - } deriving (Show, Eq) - --- | Returns true if the key was found -key :: BS.ByteString -- ^ The key to look for - -> [Token] -- ^ Tokens to consider - -> Bool -- ^ Result -key _ [] = False -- Key was not found -key k1 (Token k2 _:xs) = (k1 == k2) || key k1 xs -- If keys match, return true, otherwise enter recursion - --- | Looks up a key and returns the value if found -value :: BS.ByteString -- ^ Key to look for - -> [Token] -- ^ Tokens to consider - -> Maybe BS.ByteString -- ^ The value if the key was found -value _ [] = Nothing -- Key not found! -value k1 (Token k2 v:xs) = if k1 == k2 -- This assumes keys are unique - then v -- This returns the value of the key, if any value is associated - else value k1 xs -- Otherwise we continue our quest (in recursion) - --- | Retrieves value, and applies it to an Attoparsec parser -valueAs :: Atto.Parser a - -> BS.ByteString - -> [Token] - -> Maybe a -valueAs p k xs = - let parseValue bs = - case Atto.parseOnly p bs of - Left _ -> Nothing - Right r -> Just r - - in case value k xs of - Nothing -> Nothing - Just v -> parseValue v - --- | Retrieves first line that starts with a certain token -line :: BS.ByteString -- ^ Token key to look for - -> [Line] -- ^ Lines to consider - -> Maybe Line -- ^ The line that starts with this key, if found -line _ [] = Nothing -line k1 (x:xs) = - case x of - Line _ (Token k2 _:_) -> if k1 == k2 - then Just x - else line k1 xs - _ -> line k1 xs - --- | Returns status code of a reply. -statusCode :: [Line] - -> Integer -statusCode = lineStatusCode . head +-- | Abstract syntax tree used by the 'Parser', including helper functions+-- for traversing the tree.+--+-- __Warning__: This function is used internally by 'Network.Anonymous.Tor'+-- and using these functions directly is unsupported. The+-- interface of these functions might change at any time without+-- prior notice.+--++module Network.Anonymous.Tor.Protocol.Parser.Ast where+import qualified Data.Attoparsec.ByteString as Atto++import qualified Data.ByteString as BS++-- | A token is a key and can maybe have an associated value+data Token = Token {+ tokenKey :: BS.ByteString,+ tokenValue :: Maybe BS.ByteString+ } deriving (Show, Eq)++-- | A line is just a sequence of tokens -- the 'Parser' ends the chain+-- when a newline is received.+data Line = Line {+ lineStatusCode :: Integer,+ lineMessage :: [Token]+ } deriving (Show, Eq)++-- | Returns true if the key was found+key :: BS.ByteString -- ^ The key to look for+ -> [Token] -- ^ Tokens to consider+ -> Bool -- ^ Result+key _ [] = False -- Key was not found+key k1 (Token k2 _:xs) = (k1 == k2) || key k1 xs -- If keys match, return true, otherwise enter recursion++-- | Looks up a key and returns the value if found+value :: BS.ByteString -- ^ Key to look for+ -> [Token] -- ^ Tokens to consider+ -> Maybe BS.ByteString -- ^ The value if the key was found+value _ [] = Nothing -- Key not found!+value k1 (Token k2 v:xs) = if k1 == k2 -- This assumes keys are unique+ then v -- This returns the value of the key, if any value is associated+ else value k1 xs -- Otherwise we continue our quest (in recursion)++-- | Retrieves value, and applies it to an Attoparsec parser+valueAs :: Atto.Parser a+ -> BS.ByteString+ -> [Token]+ -> Maybe a+valueAs p k xs =+ let parseValue bs =+ case Atto.parseOnly p bs of+ Left _ -> Nothing+ Right r -> Just r++ in case value k xs of+ Nothing -> Nothing+ Just v -> parseValue v++-- | Retrieves first line that starts with a certain token+line :: BS.ByteString -- ^ Token key to look for+ -> [Line] -- ^ Lines to consider+ -> Maybe Line -- ^ The line that starts with this key, if found+line _ [] = Nothing+line k1 (x:xs) =+ case x of+ Line _ (Token k2 _:_) -> if k1 == k2+ then Just x+ else line k1 xs+ _ -> line k1 xs++-- | Returns status code of a reply.+statusCode :: [Line]+ -> Integer+statusCode = lineStatusCode . head
src/Network/Anonymous/Tor/Protocol/Types.hs view
@@ -1,32 +1,32 @@--- | Types used by the 'Network.Anonymous.Tor.Protocol' module - -module Network.Anonymous.Tor.Protocol.Types where - --- | Authentication types supported by the Tor service -data AuthMethod = - Cookie | SafeCookie | HashedPassword - - deriving (Eq) - -instance Read AuthMethod where - readsPrec _ "COOKIE" = [(Cookie, "")] - readsPrec _ "SAFECOOKIE" = [(SafeCookie, "")] - readsPrec _ "HASHEDPASSWORD" = [(HashedPassword, "")] - readsPrec _ s = error ("Not a valid AuthMethod: " ++ s) - -instance Show AuthMethod where - show Cookie = "COOKIE" - show SafeCookie = "SAFECOOKIE" - show HashedPassword = "HASHEDPASSWORD" - --- | Information about our protocol (and version) -data ProtocolInfo = ProtocolInfo { - protocolVersion :: Integer, - - torVersion :: [Integer], - - authMethods :: [AuthMethod], - - cookieFile :: Maybe FilePath - - } deriving (Show, Eq) +-- | Types used by the 'Network.Anonymous.Tor.Protocol' module++module Network.Anonymous.Tor.Protocol.Types where++-- | Authentication types supported by the Tor service+data AuthMethod =+ Cookie | SafeCookie | HashedPassword++ deriving (Eq)++instance Read AuthMethod where+ readsPrec _ "COOKIE" = [(Cookie, "")]+ readsPrec _ "SAFECOOKIE" = [(SafeCookie, "")]+ readsPrec _ "HASHEDPASSWORD" = [(HashedPassword, "")]+ readsPrec _ s = error ("Not a valid AuthMethod: " ++ s)++instance Show AuthMethod where+ show Cookie = "COOKIE"+ show SafeCookie = "SAFECOOKIE"+ show HashedPassword = "HASHEDPASSWORD"++-- | Information about our protocol (and version)+data ProtocolInfo = ProtocolInfo {+ protocolVersion :: Integer,++ torVersion :: [Integer],++ authMethods :: [AuthMethod],++ cookieFile :: Maybe FilePath++ } deriving (Show, Eq)
test/Main.hs view
@@ -1,10 +1,10 @@-module Main where - -import Test.Hspec.Runner -import qualified Spec - -import Network (withSocketsDo) - -main :: IO () -main = - withSocketsDo $ hspecWith defaultConfig Spec.spec +module Main where++import Test.Hspec.Runner+import qualified Spec++import Network (withSocketsDo)++main :: IO ()+main =+ withSocketsDo $ hspecWith defaultConfig Spec.spec
test/Spec.hs view
@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}