propellor

propellor config for hosts.
git clone git://git.ricketyspace.net/propellor.git
Log | Files | Refs | LICENSE

Tor.hs (6865B)


      1 {-# LANGUAGE TypeFamilies #-}
      2 
      3 module Propellor.Property.Tor where
      4 
      5 import Propellor.Base
      6 import qualified Propellor.Property.File as File
      7 import qualified Propellor.Property.Apt as Apt
      8 import qualified Propellor.Property.Service as Service
      9 import qualified Propellor.Property.ConfFile as ConfFile
     10 import Utility.DataUnits
     11 
     12 import System.Posix.Files
     13 import Data.Char
     14 import Data.List
     15 
     16 type HiddenServiceName = String
     17 
     18 type NodeName = String
     19 
     20 -- | Sets up a tor bridge. (Not a relay or exit node.)
     21 --
     22 -- Uses port 443
     23 isBridge :: Property DebianLike
     24 isBridge = configured
     25 	[ ("BridgeRelay", "1")
     26 	, ("Exitpolicy", "reject *:*")
     27 	, ("ORPort", "443")
     28 	]
     29 	`describe` "tor bridge"
     30 	`requires` server
     31 
     32 -- | Sets up a tor relay.
     33 --
     34 -- Uses port 443
     35 isRelay :: Property DebianLike
     36 isRelay = configured
     37 	[ ("BridgeRelay", "0")
     38 	, ("Exitpolicy", "reject *:*")
     39 	, ("ORPort", "443")
     40 	]
     41 	`describe` "tor relay"
     42 	`requires` server
     43 
     44 -- | Makes the tor node be named, with a known private key.
     45 --
     46 -- This can be moved to a different IP without needing to wait to
     47 -- accumulate trust.
     48 named :: NodeName -> Property (HasInfo + DebianLike)
     49 named n = configured [("Nickname", n')]
     50 	`describe` ("tor node named " ++ n')
     51 	`requires` torPrivKey (Context ("tor " ++ n))
     52   where
     53 	n' = saneNickname n
     54 
     55 -- | Configures tor with secret_id_key, ed25519_master_id_public_key,
     56 -- and ed25519_master_id_secret_key from privdata.
     57 torPrivKey :: Context -> Property (HasInfo + DebianLike)
     58 torPrivKey context = mconcat (map go keyfiles)
     59 	`onChange` restarted
     60 	`requires` torPrivKeyDirExists
     61   where
     62 	keyfiles = map (torPrivKeyDir </>)
     63 		[ "secret_id_key"
     64 		, "ed25519_master_id_public_key"
     65 		, "ed25519_master_id_secret_key"
     66 		]
     67 	go f = f `File.hasPrivContent` context
     68 		`onChange` File.ownerGroup f user (userGroup user)
     69 
     70 torPrivKeyDirExists :: Property DebianLike
     71 torPrivKeyDirExists = File.dirExists torPrivKeyDir
     72 	`onChange` setperms
     73 	`requires` installed
     74   where
     75 	setperms = File.ownerGroup torPrivKeyDir user (userGroup user)
     76 		`before` File.mode torPrivKeyDir 0O2700
     77 
     78 torPrivKeyDir :: FilePath
     79 torPrivKeyDir = "/var/lib/tor/keys"
     80 
     81 -- | A tor server (bridge, relay, or exit)
     82 -- Don't use if you just want to run tor for personal use.
     83 server :: Property DebianLike
     84 server = configured [("SocksPort", "0")]
     85 	`requires` installed
     86 	`requires` Apt.installed ["ntp"]
     87 	`describe` "tor server"
     88 
     89 installed :: Property DebianLike
     90 installed = Apt.installed ["tor"]
     91 
     92 -- | Specifies configuration settings. Any lines in the config file
     93 -- that set other values for the specified settings will be removed,
     94 -- while other settings are left as-is. Tor is restarted when
     95 -- configuration is changed.
     96 configured :: [(String, String)] -> Property DebianLike
     97 configured settings = File.fileProperty "tor configured" go mainConfig
     98 	`onChange` restarted
     99   where
    100 	ks = map fst settings
    101 	go ls = sort $ map toconfig $
    102 		filter (\(k, _) -> k `notElem` ks) (map fromconfig ls)
    103 		++ settings
    104 	toconfig (k, v) = k ++ " " ++ v
    105 	fromconfig = separate (== ' ')
    106 
    107 data BwLimit
    108 	= PerSecond String
    109 	| PerDay String
    110 	| PerMonth String
    111 
    112 -- | Limit incoming and outgoing traffic to the specified
    113 -- amount each.
    114 --
    115 -- For example, PerSecond "30 kibibytes" is the minimum limit
    116 -- for a useful relay.
    117 bandwidthRate :: BwLimit -> Property DebianLike
    118 bandwidthRate (PerSecond s) = bandwidthRate' s 1
    119 bandwidthRate (PerDay s) = bandwidthRate' s (24*60*60)
    120 bandwidthRate (PerMonth s) = bandwidthRate' s (31*24*60*60)
    121 
    122 bandwidthRate' :: String -> Integer -> Property DebianLike
    123 bandwidthRate' s divby = case readSize dataUnits s of
    124 	Just sz -> let v = show (sz `div` divby) ++ " bytes"
    125 		in configured [("BandwidthRate", v)]
    126 			`describe` ("tor BandwidthRate " ++ v)
    127 	Nothing -> property ("unable to parse " ++ s) noChange
    128 
    129 -- | Enables a hidden service for a given port.
    130 --
    131 -- If used without `hiddenServiceData`, tor will generate a new
    132 -- private key.
    133 hiddenService :: HiddenServiceName -> Port -> Property DebianLike
    134 hiddenService hn port = hiddenService' hn [port]
    135 
    136 hiddenService' :: HiddenServiceName -> [Port] -> Property DebianLike
    137 hiddenService' hn ports = ConfFile.adjustSection
    138 	(unwords ["hidden service", hn, "available on ports", intercalate "," (map val ports')])
    139 	(== oniondir)
    140 	(not . isPrefixOf "HiddenServicePort")
    141 	(const (oniondir : onionports))
    142 	(++ oniondir : onionports)
    143 	mainConfig
    144 	`onChange` restarted
    145   where
    146 	oniondir = unwords ["HiddenServiceDir", varLib </> hn]
    147 	onionports = map onionport ports'
    148 	ports' = sort ports
    149 	onionport port = unwords ["HiddenServicePort", val port, "127.0.0.1:" ++ val port]
    150 
    151 -- | Same as `hiddenService` but also causes propellor to display
    152 -- the onion address of the hidden service.
    153 hiddenServiceAvailable :: HiddenServiceName -> Port -> Property DebianLike
    154 hiddenServiceAvailable hn port = hiddenServiceAvailable' hn [port]
    155 
    156 hiddenServiceAvailable' :: HiddenServiceName -> [Port] -> Property DebianLike
    157 hiddenServiceAvailable' hn ports = hiddenServiceHostName $ hiddenService' hn ports
    158   where
    159 	hiddenServiceHostName p =  adjustPropertySatisfy p $ \satisfy -> do
    160 		r <- satisfy
    161 		mh <- liftIO $ tryIO $ readFile (varLib </> hn </> "hostname")
    162 		case mh of
    163 			Right h -> infoMessage ["hidden service hostname:", h]
    164 			Left _e -> warningMessage "hidden service hostname not available yet"
    165 		return r
    166 
    167 -- | Load the private key for a hidden service from the privdata.
    168 hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property (HasInfo + DebianLike)
    169 hiddenServiceData hn context = combineProperties desc $ props
    170 	& installonion "hostname"
    171 	& installonion "private_key"
    172   where
    173 	desc = unwords ["hidden service data available in", varLib </> hn]
    174 	installonion :: FilePath -> Property (HasInfo + DebianLike)
    175 	installonion basef =
    176 		let f = varLib </> hn </> basef
    177 		in withPrivData (PrivFile f) context $ \getcontent ->
    178 		property' desc $ \w -> getcontent $ \privcontent ->
    179 			ifM (liftIO $ doesFileExist f)
    180 				( noChange
    181 				, ensureProperty w $ propertyList desc $ toProps
    182 					[ property desc $ makeChange $ do
    183 						createDirectoryIfMissing True (takeDirectory f)
    184 						writeFileProtected f (unlines (privDataLines privcontent))
    185 					, File.mode (takeDirectory f) $ combineModes
    186 						[ownerReadMode, ownerWriteMode, ownerExecuteMode]
    187 					, File.ownerGroup (takeDirectory f) user (userGroup user)
    188 					, File.ownerGroup f user (userGroup user)
    189 					]
    190 				)
    191 
    192 restarted :: Property DebianLike
    193 restarted = Service.restarted "tor"
    194 
    195 mainConfig :: FilePath
    196 mainConfig = "/etc/tor/torrc"
    197 
    198 varLib :: FilePath
    199 varLib = "/var/lib/tor"
    200 
    201 varRun :: FilePath
    202 varRun = "/var/run/tor"
    203 
    204 user :: User
    205 user = User "debian-tor"
    206 
    207 type NickName = String
    208 
    209 -- | Convert String to a valid tor NickName.
    210 saneNickname :: String -> NickName
    211 saneNickname s
    212 	| null n = "unnamed"
    213 	| otherwise = n
    214   where
    215 	legal c = isNumber c || isAsciiUpper c || isAsciiLower c
    216 	n = take 19 $ filter legal s