diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,9 @@ -network-anonymous-tor -===================== - -[![Build Status](https://travis-ci.org/solatis/haskell-network-anonymous-tor.png?branch=master)](https://travis-ci.org/solatis/haskell-network-anonymous-tor) -[![Coverage Status](https://coveralls.io/repos/solatis/haskell-network-anonymous-tor/badge.svg?branch=master)](https://coveralls.io/r/solatis/haskell-network-anonymous-tor?branch=master) -[![MIT](http://b.repl.ca/v1/license-MIT-blue.png)](http://en.wikipedia.org/wiki/MIT_License) -[![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) - -network-anonymous-tor is a Haskell API for Tor anonymous networking +network-anonymous-tor +===================== + +[![Build Status](https://travis-ci.org/solatis/haskell-network-anonymous-tor.png?branch=master)](https://travis-ci.org/solatis/haskell-network-anonymous-tor) +[![Coverage Status](https://coveralls.io/repos/solatis/haskell-network-anonymous-tor/badge.svg?branch=master)](https://coveralls.io/r/solatis/haskell-network-anonymous-tor?branch=master) +[![MIT](http://b.repl.ca/v1/license-MIT-blue.png)](http://en.wikipedia.org/wiki/MIT_License) +[![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) + +network-anonymous-tor is a Haskell API for Tor anonymous networking diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,3 +1,3 @@ -import Distribution.Simple - -main = defaultMain +import Distribution.Simple + +main = defaultMain diff --git a/examples/Relay.lhs b/examples/Relay.lhs --- a/examples/Relay.lhs +++ b/examples/Relay.lhs @@ -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) diff --git a/network-anonymous-tor.cabal b/network-anonymous-tor.cabal --- a/network-anonymous-tor.cabal +++ b/network-anonymous-tor.cabal @@ -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 diff --git a/src/Network/Anonymous/Tor.hs b/src/Network/Anonymous/Tor.hs --- a/src/Network/Anonymous/Tor.hs +++ b/src/Network/Anonymous/Tor.hs @@ -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: --- --- -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: +-- +-- +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 diff --git a/src/Network/Anonymous/Tor/Error.hs b/src/Network/Anonymous/Tor/Error.hs --- a/src/Network/Anonymous/Tor/Error.hs +++ b/src/Network/Anonymous/Tor/Error.hs @@ -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 diff --git a/src/Network/Anonymous/Tor/Protocol.hs b/src/Network/Anonymous/Tor/Protocol.hs --- a/src/Network/Anonymous/Tor/Protocol.hs +++ b/src/Network/Anonymous/Tor/Protocol.hs @@ -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 diff --git a/src/Network/Anonymous/Tor/Protocol/Parser.hs b/src/Network/Anonymous/Tor/Protocol/Parser.hs --- a/src/Network/Anonymous/Tor/Protocol/Parser.hs +++ b/src/Network/Anonymous/Tor/Protocol/Parser.hs @@ -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 diff --git a/src/Network/Anonymous/Tor/Protocol/Parser/Ast.hs b/src/Network/Anonymous/Tor/Protocol/Parser/Ast.hs --- a/src/Network/Anonymous/Tor/Protocol/Parser/Ast.hs +++ b/src/Network/Anonymous/Tor/Protocol/Parser/Ast.hs @@ -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 diff --git a/src/Network/Anonymous/Tor/Protocol/Types.hs b/src/Network/Anonymous/Tor/Protocol/Types.hs --- a/src/Network/Anonymous/Tor/Protocol/Types.hs +++ b/src/Network/Anonymous/Tor/Protocol/Types.hs @@ -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) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,1 +1,1 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}