{-# LANGUAGE TypeFamilies #-}
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.DataUnits
import System.Posix.Files
import Data.Char
import Data.List
type HiddenServiceName = String
type NodeName = String
isBridge :: Property DebianLike
isBridge :: Property DebianLike
isBridge = [(String, String)] -> Property DebianLike
configured
[ (String
"BridgeRelay", String
"1")
, (String
"Exitpolicy", String
"reject *:*")
, (String
"ORPort", String
"443")
]
forall p. IsProp p => p -> String -> p
`describe` String
"tor bridge"
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
server
isRelay :: Property DebianLike
isRelay :: Property DebianLike
isRelay = [(String, String)] -> Property DebianLike
configured
[ (String
"BridgeRelay", String
"0")
, (String
"Exitpolicy", String
"reject *:*")
, (String
"ORPort", String
"443")
]
forall p. IsProp p => p -> String -> p
`describe` String
"tor relay"
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
server
named :: NodeName -> Property (HasInfo + DebianLike)
named :: String -> Property (HasInfo + DebianLike)
named String
n = [(String, String)] -> Property DebianLike
configured [(String
"Nickname", String
n')]
forall p. IsProp p => p -> String -> p
`describe` (String
"tor node named " forall a. [a] -> [a] -> [a]
++ String
n')
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Context -> Property (HasInfo + DebianLike)
torPrivKey (String -> Context
Context (String
"tor " forall a. [a] -> [a] -> [a]
++ String
n))
where
n' :: String
n' = String -> String
saneNickname String
n
torPrivKey :: Context -> Property (HasInfo + DebianLike)
torPrivKey :: Context -> Property (HasInfo + DebianLike)
torPrivKey Context
context = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map String
-> CombinedType
(Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
(Property UnixLike)
go [String]
keyfiles)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
restarted
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
torPrivKeyDirExists
where
keyfiles :: [String]
keyfiles = forall a b. (a -> b) -> [a] -> [b]
map (String
torPrivKeyDir String -> String -> String
</>)
[ String
"secret_id_key"
, String
"ed25519_master_id_public_key"
, String
"ed25519_master_id_secret_key"
]
go :: String
-> CombinedType
(Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
(Property UnixLike)
go String
f = String
f forall c.
IsContext c =>
String -> c -> Property (HasInfo + UnixLike)
`File.hasPrivContent` Context
context
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` String -> User -> Group -> Property UnixLike
File.ownerGroup String
f User
user (User -> Group
userGroup User
user)
torPrivKeyDirExists :: Property DebianLike
torPrivKeyDirExists :: Property DebianLike
torPrivKeyDirExists = String -> Property UnixLike
File.dirExists String
torPrivKeyDir
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property UnixLike
setperms
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
where
setperms :: CombinedType (Property UnixLike) (Property UnixLike)
setperms = String -> User -> Group -> Property UnixLike
File.ownerGroup String
torPrivKeyDir User
user (User -> Group
userGroup User
user)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` String -> FileMode -> Property UnixLike
File.mode String
torPrivKeyDir FileMode
0O2700
torPrivKeyDir :: FilePath
torPrivKeyDir :: String
torPrivKeyDir = String
"/var/lib/tor/keys"
server :: Property DebianLike
server :: Property DebianLike
server = [(String, String)] -> Property DebianLike
configured [(String
"SocksPort", String
"0")]
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [String] -> Property DebianLike
Apt.installed [String
"ntp"]
forall p. IsProp p => p -> String -> p
`describe` String
"tor server"
installed :: Property DebianLike
installed :: Property DebianLike
installed = [String] -> Property DebianLike
Apt.installed [String
"tor"]
configured :: [(String, String)] -> Property DebianLike
configured :: [(String, String)] -> Property DebianLike
configured [(String, String)]
settings = forall c.
(FileContent c, Eq c) =>
String -> (c -> c) -> String -> Property UnixLike
File.fileProperty String
"tor configured" [String] -> [String]
go String
mainConfig
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
restarted
where
ks :: [String]
ks = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, String)]
settings
go :: [String] -> [String]
go [String]
ls = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
toconfig forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
k, String
_) -> String
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
ks) (forall a b. (a -> b) -> [a] -> [b]
map String -> (String, String)
fromconfig [String]
ls)
forall a. [a] -> [a] -> [a]
++ [(String, String)]
settings
toconfig :: (String, String) -> String
toconfig (String
k, String
v) = String
k forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
v
fromconfig :: String -> (String, String)
fromconfig = forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (forall a. Eq a => a -> a -> Bool
== Char
' ')
data BwLimit
= PerSecond String
| PerDay String
| PerMonth String
bandwidthRate :: BwLimit -> Property DebianLike
bandwidthRate :: BwLimit -> Property DebianLike
bandwidthRate (PerSecond String
s) = String -> ByteSize -> Property DebianLike
bandwidthRate' String
s ByteSize
1
bandwidthRate (PerDay String
s) = String -> ByteSize -> Property DebianLike
bandwidthRate' String
s (ByteSize
24forall a. Num a => a -> a -> a
*ByteSize
60forall a. Num a => a -> a -> a
*ByteSize
60)
bandwidthRate (PerMonth String
s) = String -> ByteSize -> Property DebianLike
bandwidthRate' String
s (ByteSize
31forall a. Num a => a -> a -> a
*ByteSize
24forall a. Num a => a -> a -> a
*ByteSize
60forall a. Num a => a -> a -> a
*ByteSize
60)
bandwidthRate' :: String -> Integer -> Property DebianLike
bandwidthRate' :: String -> ByteSize -> Property DebianLike
bandwidthRate' String
s ByteSize
divby = case [Unit] -> String -> Maybe ByteSize
readSize [Unit]
dataUnits String
s of
Just ByteSize
sz -> let v :: String
v = forall a. Show a => a -> String
show (ByteSize
sz forall a. Integral a => a -> a -> a
`div` ByteSize
divby) forall a. [a] -> [a] -> [a]
++ String
" bytes"
in [(String, String)] -> Property DebianLike
configured [(String
"BandwidthRate", String
v)]
forall p. IsProp p => p -> String -> p
`describe` (String
"tor BandwidthRate " forall a. [a] -> [a] -> [a]
++ String
v)
Maybe ByteSize
Nothing -> forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property (String
"unable to parse " forall a. [a] -> [a] -> [a]
++ String
s) Propellor Result
noChange
hiddenService :: HiddenServiceName -> Port -> Property DebianLike
hiddenService :: String -> Port -> Property DebianLike
hiddenService String
hn Port
port = String -> [Port] -> Property DebianLike
hiddenService' String
hn [Port
port]
hiddenService' :: HiddenServiceName -> [Port] -> Property DebianLike
hiddenService' :: String -> [Port] -> Property DebianLike
hiddenService' String
hn [Port]
ports = String
-> SectionStart
-> SectionStart
-> ([String] -> [String])
-> ([String] -> [String])
-> String
-> Property UnixLike
ConfFile.adjustSection
([String] -> String
unwords [String
"hidden service", String
hn, String
"available on ports", forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall t. ConfigurableValue t => t -> String
val [Port]
ports')])
(forall a. Eq a => a -> a -> Bool
== String
oniondir)
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"HiddenServicePort")
(forall a b. a -> b -> a
const (String
oniondir forall a. a -> [a] -> [a]
: [String]
onionports))
(forall a. [a] -> [a] -> [a]
++ String
oniondir forall a. a -> [a] -> [a]
: [String]
onionports)
String
mainConfig
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
restarted
where
oniondir :: String
oniondir = [String] -> String
unwords [String
"HiddenServiceDir", String
varLib String -> String -> String
</> String
hn]
onionports :: [String]
onionports = forall a b. (a -> b) -> [a] -> [b]
map forall t. ConfigurableValue t => t -> String
onionport [Port]
ports'
ports' :: [Port]
ports' = forall a. Ord a => [a] -> [a]
sort [Port]
ports
onionport :: t -> String
onionport t
port = [String] -> String
unwords [String
"HiddenServicePort", forall t. ConfigurableValue t => t -> String
val t
port, String
"127.0.0.1:" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val t
port]
hiddenServiceAvailable :: HiddenServiceName -> Port -> Property DebianLike
hiddenServiceAvailable :: String -> Port -> Property DebianLike
hiddenServiceAvailable String
hn Port
port = String -> [Port] -> Property DebianLike
hiddenServiceAvailable' String
hn [Port
port]
hiddenServiceAvailable' :: HiddenServiceName -> [Port] -> Property DebianLike
hiddenServiceAvailable' :: String -> [Port] -> Property DebianLike
hiddenServiceAvailable' String
hn [Port]
ports = Property DebianLike -> Property DebianLike
hiddenServiceHostName forall a b. (a -> b) -> a -> b
$ String -> [Port] -> Property DebianLike
hiddenService' String
hn [Port]
ports
where
hiddenServiceHostName :: Property DebianLike -> Property DebianLike
hiddenServiceHostName Property DebianLike
p = forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy Property DebianLike
p forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy -> do
Result
r <- Propellor Result
satisfy
Either IOException String
mh <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile (String
varLib String -> String -> String
</> String
hn String -> String -> String
</> String
"hostname")
case Either IOException String
mh of
Right String
h -> forall (m :: * -> *). MonadIO m => [String] -> m ()
infoMessage [String
"hidden service hostname:", String
h]
Left IOException
_e -> forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage String
"hidden service hostname not available yet"
forall (m :: * -> *) a. Monad m => a -> m a
return Result
r
hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property (HasInfo + DebianLike)
hiddenServiceData :: forall c.
IsContext c =>
String -> c -> Property (HasInfo + DebianLike)
hiddenServiceData String
hn c
context = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> Property (HasInfo + DebianLike)
installonion String
"hostname"
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> Property (HasInfo + DebianLike)
installonion String
"private_key"
where
desc :: String
desc = [String] -> String
unwords [String
"hidden service data available in", String
varLib String -> String -> String
</> String
hn]
installonion :: FilePath -> Property (HasInfo + DebianLike)
installonion :: String -> Property (HasInfo + DebianLike)
installonion String
basef =
let f :: String
f = String
varLib String -> String -> String
</> String
hn String -> String -> String
</> String
basef
in forall c s metatypes.
(IsContext c, IsPrivDataSource s,
IncludesInfo metatypes ~ 'True) =>
s
-> c
-> (((PrivData -> Propellor Result) -> Propellor Result)
-> Property metatypes)
-> Property metatypes
withPrivData (String -> PrivDataField
PrivFile String
f) c
context forall a b. (a -> b) -> a -> b
$ \(PrivData -> Propellor Result) -> Propellor Result
getcontent ->
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' String
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> (PrivData -> Propellor Result) -> Propellor Result
getcontent forall a b. (a -> b) -> a -> b
$ \PrivData
privcontent ->
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
f)
( Propellor Result
noChange
, forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList String
desc forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps
[ forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
desc forall a b. (a -> b) -> a -> b
$ IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
f)
String -> String -> IO ()
writeFileProtected String
f ([String] -> String
unlines (PrivData -> [String]
privDataLines PrivData
privcontent))
, String -> FileMode -> Property UnixLike
File.mode (String -> String
takeDirectory String
f) forall a b. (a -> b) -> a -> b
$ [FileMode] -> FileMode
combineModes
[FileMode
ownerReadMode, FileMode
ownerWriteMode, FileMode
ownerExecuteMode]
, String -> User -> Group -> Property UnixLike
File.ownerGroup (String -> String
takeDirectory String
f) User
user (User -> Group
userGroup User
user)
, String -> User -> Group -> Property UnixLike
File.ownerGroup String
f User
user (User -> Group
userGroup User
user)
]
)
restarted :: Property DebianLike
restarted :: Property DebianLike
restarted = String -> Property DebianLike
Service.restarted String
"tor"
mainConfig :: FilePath
mainConfig :: String
mainConfig = String
"/etc/tor/torrc"
varLib :: FilePath
varLib :: String
varLib = String
"/var/lib/tor"
varRun :: FilePath
varRun :: String
varRun = String
"/var/run/tor"
user :: User
user :: User
user = String -> User
User String
"debian-tor"
type NickName = String
saneNickname :: String -> NickName
saneNickname :: String -> String
saneNickname String
s
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n = String
"unnamed"
| Bool
otherwise = String
n
where
legal :: Char -> Bool
legal Char
c = Char -> Bool
isNumber Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiLower Char
c
n :: String
n = forall a. Int -> [a] -> [a]
take Int
19 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
legal String
s