module Propellor.Property.Tor where
import Propellor
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
import Utility.FileMode
import Utility.DataUnits
import System.Posix.Files
import Data.Char
import Data.List
type HiddenServiceName = String
type NodeName = String
isBridge :: Property NoInfo
isBridge = configured
[ ("BridgeRelay", "1")
, ("Exitpolicy", "reject *:*")
, ("ORPort", "443")
]
`describe` "tor bridge"
`requires` server
isRelay :: Property NoInfo
isRelay = configured
[ ("BridgeRelay", "0")
, ("Exitpolicy", "reject *:*")
, ("ORPort", "443")
]
`describe` "tor relay"
`requires` server
named :: NodeName -> Property HasInfo
named n = configured [("Nickname", n')]
`describe` ("tor node named " ++ n')
`requires` torPrivKey (Context ("tor " ++ n))
where
n' = saneNickname n
torPrivKey :: Context -> Property HasInfo
torPrivKey context = f `File.hasPrivContent` context
`onChange` File.ownerGroup f user (userGroup user)
`requires` Apt.installed ["tor"]
where
f = "/var/lib/tor/keys/secret_id_key"
server :: Property NoInfo
server = configured [("SocksPort", "0")]
`requires` Apt.installed ["tor", "ntp"]
`describe` "tor server"
configured :: [(String, String)] -> Property NoInfo
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 NoInfo
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 NoInfo
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
hiddenServiceAvailable :: HiddenServiceName -> Int -> Property NoInfo
hiddenServiceAvailable hn port = hiddenServiceHostName prop
where
prop = configured
[ ("HiddenServiceDir", varLib </> hn)
, ("HiddenServicePort", unwords [show port, "127.0.0.1:" ++ show port])
]
`describe` "hidden service available"
hiddenServiceHostName p = adjustPropertySatisfy p $ \satisfy -> do
r <- satisfy
h <- liftIO $ readFile (varLib </> hn </> "hostname")
warningMessage $ unwords ["hidden service hostname:", h]
return r
hiddenService :: HiddenServiceName -> Int -> Property NoInfo
hiddenService hn port = configured
[ ("HiddenServiceDir", varLib </> hn)
, ("HiddenServicePort", unwords [show port, "127.0.0.1:" ++ show port])
]
`describe` unwords ["hidden service available:", hn, show port]
hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property HasInfo
hiddenServiceData hn context = combineProperties desc
[ installonion "hostname"
, installonion "private_key"
]
where
desc = unwords ["hidden service data available in", varLib </> hn]
installonion f = withPrivData (PrivFile $ varLib </> hn </> f) context $ \getcontent ->
property desc $ getcontent $ install $ varLib </> hn </> f
install f content = ifM (liftIO $ doesFileExist f)
( noChange
, ensureProperties
[ property desc $ makeChange $ do
createDirectoryIfMissing True (takeDirectory f)
writeFileProtected f content
, File.mode (takeDirectory f) $ combineModes
[ownerReadMode, ownerWriteMode, ownerExecuteMode]
, File.ownerGroup (takeDirectory f) user (userGroup user)
, File.ownerGroup f user (userGroup user)
]
)
restarted :: Property NoInfo
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