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 type HiddenServiceName = String type NodeName = String -- | Sets up a tor bridge. (Not a relay or exit node.) -- -- Uses port 443 isBridge :: Property NoInfo isBridge = configured [ ("BridgeRelay", "1") , ("Exitpolicy", "reject *:*") , ("ORPort", "443") ] `describe` "tor bridge" `requires` server -- | Sets up a tor relay. -- -- Uses port 443 isRelay :: Property NoInfo isRelay = configured [ ("BridgeRelay", "0") , ("Exitpolicy", "reject *:*") , ("ORPort", "443") ] `describe` "tor relay" `requires` server -- | Makes the tor node be named, with a known private key. -- -- This can be moved to a different IP without needing to wait to -- accumulate trust. 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 user -- install tor first, so the directory exists with right perms `requires` Apt.installed ["tor"] where f = "/var/lib/tor/keys/secret_id_key" -- | A tor server (bridge, relay, or exit) -- Don't use if you just want to run tor for personal use. server :: Property NoInfo server = configured [("SocksPort", "0")] `requires` Apt.installed ["tor", "ntp"] `describe` "tor server" -- | Specifies configuration settings. Any lines in the config file -- that set other values for the specified settings will be removed, -- while other settings are left as-is. Tor is restarted when -- configuration is changed. configured :: [(String, String)] -> Property NoInfo configured settings = File.fileProperty "tor configured" go mainConfig `onChange` restarted where ks = map fst settings go ls = map toconfig $ filter (\(k, _) -> k `notElem` ks) (map fromconfig ls) ++ settings toconfig (k, v) = k ++ " " ++ v fromconfig = separate (== ' ') type BwLimit = String -- | Limit incoming and outgoing traffic to the specified -- amount, per second. -- -- For example, "30 kibibytes" is the minimum limit for a useful relay. bandwidthRate :: BwLimit -> Property NoInfo bandwidthRate s = case readSize dataUnits s of Just sz -> configured [("BandwidthRate", show sz ++ " bytes")] 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 user , File.ownerGroup f user 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 :: UserName user = "debian-tor" type NickName = String -- | Convert String to a valid tor NickName. 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