summaryrefslogtreecommitdiff
path: root/Utility/Tor.hs
blob: e63bd82d4c8072e6c641da251a2a867e263db008 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
{- tor interface
 -
 - Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Utility.Tor where

import Common
import Utility.ThreadScheduler
import Utility.FileMode

import System.PosixCompat.Types
import Data.Char
import Network.Socket
import Network.Socks5
import qualified Data.ByteString.UTF8 as BU8
import qualified System.Random as R

type OnionPort = Int

newtype OnionAddress = OnionAddress String
	deriving (Show, Eq)

type OnionSocket = FilePath

type UniqueIdent = String

connectHiddenService :: OnionAddress -> OnionPort -> IO Socket
connectHiddenService (OnionAddress address) port = do
	hPutStrLn stderr $ show ("connect to", address, port)
	(s, _) <- socksConnect torsockconf socksaddr
	return s
  where
	torsocksport = 9050
	torsockconf = defaultSocksConf "127.0.0.1" torsocksport
	socksdomain = SocksAddrDomainName (BU8.fromString address)
	socksaddr = SocksAddress socksdomain (fromIntegral port)

-- | Adds a hidden service connecting to localhost, using some kind
-- of unique identifier.
--
-- This will only work if run as root, and tor has to already be running.
--
-- Picks a random high port number for the hidden service that is not
-- used by any other hidden service. Returns the hidden service's
-- onion address, port, and the unix socket file to use.
-- 
-- If there is already a hidden service for the specified unique
-- identifier, returns its information without making any changes.
addHiddenService :: UserID -> UniqueIdent -> IO (OnionAddress, OnionPort)
addHiddenService uid ident = do
	prepHiddenServiceSocketDir uid ident
	ls <- lines <$> readFile torrc
	let portssocks = mapMaybe (parseportsock . separate isSpace) ls
	case filter (\(_, s) -> s == sockfile) portssocks of
		((p, _s):_) -> waithiddenservice 1 p
		_ -> do
			highports <- R.getStdRandom mkhighports
			let newport = Prelude.head $
				filter (`notElem` map fst portssocks) highports
			writeFile torrc $ unlines $
				ls ++
				[ ""
				, "HiddenServiceDir " ++ hiddenServiceDir uid ident
				, "HiddenServicePort " ++ show newport ++ 
					" unix:" ++ sockfile
				]
			-- Reload tor, so it will see the new hidden
			-- service and generate the hostname file for it.
			reloaded <- anyM (uncurry boolSystem)
				[ ("systemctl", [Param "reload", Param "tor"])
				, ("sefvice", [Param "tor", Param "reload"])
				]
			unless reloaded $
				giveup "failed to reload tor, perhaps the tor service is not running"
			waithiddenservice 120 newport
  where
	parseportsock ("HiddenServicePort", l) = do
		p <- readish $ takeWhile (not . isSpace) l
		return (p, drop 1 (dropWhile (/= ':') l))
	parseportsock _ = Nothing
	
	sockfile = hiddenServiceSocketFile uid ident

	-- An infinite random list of high ports.
	mkhighports g = 
		let (g1, g2) = R.split g
		in (R.randomRs (1025, 65534) g1, g2)

	waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort)
	waithiddenservice 0 _ = giveup "tor failed to create hidden service, perhaps the tor service is not running"
	waithiddenservice n p = do
		v <- tryIO $ readFile $ hiddenServiceHostnameFile uid ident
		case v of
			Right s | ".onion\n" `isSuffixOf` s ->
				return (OnionAddress (takeWhile (/= '\n') s), p)
			_ -> do
				threadDelaySeconds (Seconds 1)
				waithiddenservice (n-1) p

-- | A hidden service directory to use.
--
-- The "hs" is used in the name to prevent too long a path name,
-- which could present problems for socketFile.
hiddenServiceDir :: UserID -> UniqueIdent -> FilePath
hiddenServiceDir uid ident = libDir </> "hs_" ++ show uid ++ "_" ++ ident

hiddenServiceHostnameFile :: UserID -> UniqueIdent -> FilePath
hiddenServiceHostnameFile uid ident = hiddenServiceDir uid ident </> "hostname"

-- | Location of the socket for a hidden service.
--
-- This has to be a location that tor can read from, and that the user
-- can write to. Tor is often prevented by apparmor from reading
-- from many locations. Putting it in /etc is a FHS violation, but it's the
-- simplest and most robust choice until http://bugs.debian.org/846275 is
-- dealt with.
--
-- Note that some unix systems limit socket paths to 92 bytes long.
-- That should not be a problem if the UniqueIdent is around the length of
-- a UUID.
hiddenServiceSocketFile :: UserID -> UniqueIdent -> FilePath
hiddenServiceSocketFile uid ident = etcDir </> "hidden_services" </> show uid ++ "_" ++ show ident </> "s"

-- | Sets up the directory for the socketFile, with appropriate
-- permissions. Must run as root.
prepHiddenServiceSocketDir :: UserID -> UniqueIdent -> IO ()
prepHiddenServiceSocketDir uid ident = do
	createDirectoryIfMissing True d
	setOwnerAndGroup d uid (-1)
	modifyFileMode d $
		addModes [ownerReadMode, ownerExecuteMode, ownerWriteMode]
  where
	d = takeDirectory $ hiddenServiceSocketFile uid ident

torrc :: FilePath
torrc = "/etc/tor/torrc"

libDir :: FilePath
libDir = "/var/lib/tor"

etcDir :: FilePath
etcDir = "/etc/tor"