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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
{- 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
-- | A unique identifier for a hidden service.
type UniqueIdent = String
-- | Name of application that is providing a hidden service.
type AppName = String
connectHiddenService :: OnionAddress -> OnionPort -> IO Socket
connectHiddenService (OnionAddress address) port = do
(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 :: AppName -> UserID -> UniqueIdent -> IO (OnionAddress, OnionPort)
addHiddenService appname uid ident = do
prepHiddenServiceSocketDir appname uid ident
ls <- lines <$> (readFile =<< findTorrc)
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
torrc <- findTorrc
writeFile torrc $ unlines $
ls ++
[ ""
, "HiddenServiceDir " ++ hiddenServiceDir appname 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"])
, ("service", [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 appname 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 appname 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.
--
-- Has to be inside the torLibDir so tor can create it.
--
-- Has to end with "uid_ident" so getHiddenServiceSocketFile can find it.
hiddenServiceDir :: AppName -> UserID -> UniqueIdent -> FilePath
hiddenServiceDir appname uid ident = torLibDir </> appname ++ "_" ++ show uid ++ "_" ++ ident
hiddenServiceHostnameFile :: AppName -> UserID -> UniqueIdent -> FilePath
hiddenServiceHostnameFile appname uid ident = hiddenServiceDir appname 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. Since torLibDir is locked down, it can't go in there.
--
-- 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, and the AppName is short.
hiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> FilePath
hiddenServiceSocketFile appname uid ident = varLibDir </> appname </> show uid ++ "_" ++ ident </> "s"
-- | Parse torrc, to get the socket file used for a hidden service with
-- the specified UniqueIdent.
getHiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> IO (Maybe FilePath)
getHiddenServiceSocketFile _appname uid ident =
parse . map words . lines <$> catchDefaultIO "" (readFile =<< findTorrc)
where
parse [] = Nothing
parse (("HiddenServiceDir":hsdir:[]):("HiddenServicePort":_hsport:hsaddr:[]):rest)
| "unix:" `isPrefixOf` hsaddr && hasident hsdir =
Just (drop (length "unix:") hsaddr)
| otherwise = parse rest
parse (_:rest) = parse rest
-- Don't look for AppName in the hsdir, because it didn't used to
-- be included.
hasident hsdir = (show uid ++ "_" ++ ident) `isSuffixOf` takeFileName hsdir
-- | Sets up the directory for the socketFile, with appropriate
-- permissions. Must run as root.
prepHiddenServiceSocketDir :: AppName -> UserID -> UniqueIdent -> IO ()
prepHiddenServiceSocketDir appname uid ident = do
createDirectoryIfMissing True d
setOwnerAndGroup d uid (-1)
modifyFileMode d $
addModes [ownerReadMode, ownerExecuteMode, ownerWriteMode]
where
d = takeDirectory $ hiddenServiceSocketFile appname uid ident
-- | Finds the system's torrc file, in any of the typical locations of it.
-- Returns the first found. If there is no system torrc file, defaults to
-- /etc/tor/torrc.
findTorrc :: IO FilePath
findTorrc = fromMaybe "/etc/tor/torrc" <$> firstM doesFileExist
-- Debian
[ "/etc/tor/torrc"
-- Some systems put it here instead.
, "/etc/torrc"
-- Default when installed from source
, "/usr/local/etc/tor/torrc"
]
torLibDir :: FilePath
torLibDir = "/var/lib/tor"
varLibDir :: FilePath
varLibDir = "/var/lib"
torIsInstalled :: IO Bool
torIsInstalled = inPath "tor"
|
