module Propellor.Property.Tor where
import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
import qualified Propellor.Property.ConfFile as ConfFile
import Utility.FileMode
import Utility.DataUnits
import System.Posix.Files
import Data.Char
import Data.List
type HiddenServiceName = String
type NodeName = String
isBridge :: Property DebianLike
isBridge = configured
[ ("BridgeRelay", "1")
, ("Exitpolicy", "reject *:*")
, ("ORPort", "443")
]
`describe` "tor bridge"
`requires` server
isRelay :: Property DebianLike
isRelay = configured
[ ("BridgeRelay", "0")
, ("Exitpolicy", "reject *:*")
, ("ORPort", "443")
]
`describe` "tor relay"
`requires` server
named :: NodeName -> Property (HasInfo + DebianLike)
named n = configured [("Nickname", n')]
`describe` ("tor node named " ++ n')
`requires` torPrivKey (Context ("tor " ++ n))
where
n' = saneNickname n
torPrivKey :: Context -> Property (HasInfo + DebianLike)
torPrivKey context = mconcat (map go keyfiles)
`onChange` restarted
`requires` torPrivKeyDirExists
where
keyfiles = map (torPrivKeyDir </>)
[ "secret_id_key"
, "ed25519_master_id_public_key"
, "ed25519_master_id_secret_key"
]
go f = f `File.hasPrivContent` context
`onChange` File.ownerGroup f user (userGroup user)
torPrivKeyDirExists :: Property DebianLike
torPrivKeyDirExists = File.dirExists torPrivKeyDir
`onChange` setperms
`requires` installed
where
setperms = File.ownerGroup torPrivKeyDir user (userGroup user)
`before` File.mode torPrivKeyDir 0O2700
torPrivKeyDir :: FilePath
torPrivKeyDir = "/var/lib/tor/keys"
server :: Property DebianLike
server = configured [("SocksPort", "0")]
`requires` installed
`requires` Apt.installed ["ntp"]
`describe` "tor server"
installed :: Property DebianLike
installed = Apt.installed ["tor"]
configured :: [(String, String)] -> Property DebianLike
configured settings = File.fileProperty "tor configured" go mainConfig
`onChange` restarted
where
ks = map fst settings
go ls = sort $ map toconfig $
filter (\(k, _) -> k `notElem` ks) (map fromconfig ls)
++ settings
toconfig (k, v) = k ++ " " ++ v
fromconfig = separate (== ' ')
data BwLimit
= PerSecond String
| PerDay String
| PerMonth String
bandwidthRate :: BwLimit -> Property DebianLike
bandwidthRate (PerSecond s) = bandwidthRate' s 1
bandwidthRate (PerDay s) = bandwidthRate' s (24*60*60)
bandwidthRate (PerMonth s) = bandwidthRate' s (31*24*60*60)
bandwidthRate' :: String -> Integer -> Property DebianLike
bandwidthRate' s divby = case readSize dataUnits s of
Just sz -> let v = show (sz `div` divby) ++ " bytes"
in configured [("BandwidthRate", v)]
`describe` ("tor BandwidthRate " ++ v)
Nothing -> property ("unable to parse " ++ s) noChange
hiddenService :: HiddenServiceName -> Port -> Property DebianLike
hiddenService hn port = hiddenService' hn [port]
hiddenService' :: HiddenServiceName -> [Port] -> Property DebianLike
hiddenService' hn ports = ConfFile.adjustSection
(unwords ["hidden service", hn, "available on ports", intercalate "," (map val ports')])
(== oniondir)
(not . isPrefixOf "HiddenServicePort")
(const (oniondir : onionports))
(++ oniondir : onionports)
mainConfig
`onChange` restarted
where
oniondir = unwords ["HiddenServiceDir", varLib </> hn]
onionports = map onionport ports'
ports' = sort ports
onionport port = unwords ["HiddenServicePort", val port, "127.0.0.1:" ++ val port]
hiddenServiceAvailable :: HiddenServiceName -> Port -> Property DebianLike
hiddenServiceAvailable hn port = hiddenServiceAvailable' hn [port]
hiddenServiceAvailable' :: HiddenServiceName -> [Port] -> Property DebianLike
hiddenServiceAvailable' hn ports = hiddenServiceHostName $ hiddenService' hn ports
where
hiddenServiceHostName p = adjustPropertySatisfy p $ \satisfy -> do
r <- satisfy
mh <- liftIO $ tryIO $ readFile (varLib </> hn </> "hostname")
case mh of
Right h -> infoMessage ["hidden service hostname:", h]
Left _e -> warningMessage "hidden service hostname not available yet"
return r
hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property (HasInfo + DebianLike)
hiddenServiceData hn context = combineProperties desc $ props
& installonion "hostname"
& installonion "private_key"
where
desc = unwords ["hidden service data available in", varLib </> hn]
installonion :: FilePath -> Property (HasInfo + DebianLike)
installonion f = withPrivData (PrivFile $ varLib </> hn </> f) context $ \getcontent ->
property' desc $ \w -> getcontent $ install w $ varLib </> hn </> f
install w f privcontent = ifM (liftIO $ doesFileExist f)
( noChange
, ensureProperty w $ propertyList desc $ toProps
[ property desc $ makeChange $ do
createDirectoryIfMissing True (takeDirectory f)
writeFileProtected f (unlines (privDataLines privcontent))
, File.mode (takeDirectory f) $ combineModes
[ownerReadMode, ownerWriteMode, ownerExecuteMode]
, File.ownerGroup (takeDirectory f) user (userGroup user)
, File.ownerGroup f user (userGroup user)
]
)
restarted :: Property DebianLike
restarted = Service.restarted "tor"
mainConfig :: FilePath
mainConfig = "/etc/tor/torrc"
varLib :: FilePath
varLib = "/var/lib/tor"
varRun :: FilePath
varRun = "/var/run/tor"
user :: User
user = User "debian-tor"
type NickName = String
saneNickname :: String -> NickName
saneNickname s
| null n = "unnamed"
| otherwise = n
where
legal c = isNumber c || isAsciiUpper c || isAsciiLower c
n = take 19 $ filter legal s