-- | Maintainer: Jelmer Vernooij <jelmer@samba.org>

module Propellor.Property.Kerberos where

import Utility.Process

import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import Propellor.Property.User

type Realm = String
type Principal = String
type Kvno = Integer

-- Standard paths in MIT Kerberos

defaultKeyTab :: FilePath
defaultKeyTab :: Principal
defaultKeyTab = Principal
"/etc/krb5.keytab"

kadmAclPath :: FilePath
kadmAclPath :: Principal
kadmAclPath = Principal
"/etc/krb5kdc/kadm5.acl"

kpropdAclPath :: FilePath
kpropdAclPath :: Principal
kpropdAclPath = Principal
"/etc/krb5kdc/kpropd.acl"

kdcConfPath :: FilePath
kdcConfPath :: Principal
kdcConfPath = Principal
"/etc/krb5kdc/kdc.conf"

keyTabPath :: Maybe FilePath -> FilePath
keyTabPath :: Maybe Principal -> Principal
keyTabPath = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Principal
defaultKeyTab forall a. a -> a
id

-- | Create a principal from a primary, instance and realm
principal :: String -> Maybe String -> Maybe Realm -> Principal
principal :: Principal -> Maybe Principal -> Maybe Principal -> Principal
principal Principal
p Maybe Principal
i Maybe Principal
r = Principal
p forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Principal
"" (Principal
"/"forall a. [a] -> [a] -> [a]
++) Maybe Principal
i forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Principal
"" (Principal
"@" forall a. [a] -> [a] -> [a]
++) Maybe Principal
r

installed :: Property DebianLike
installed :: Property DebianLike
installed = [Principal] -> Property DebianLike
Apt.installed [Principal
"krb5-user"]

kdcInstalled :: Property DebianLike
kdcInstalled :: Property DebianLike
kdcInstalled = Principal -> Property DebianLike
Apt.serviceInstalledRunning Principal
"krb5-kdc"

adminServerInstalled :: Property DebianLike
adminServerInstalled :: Property DebianLike
adminServerInstalled = Principal -> Property DebianLike
Apt.serviceInstalledRunning Principal
"krb5-admin-server"

kpropServerInstalled :: Property DebianLike
kpropServerInstalled :: Property DebianLike
kpropServerInstalled = forall {k} (metatypes :: k).
SingI metatypes =>
Principal
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Principal
"kprop server installed" 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))
& Property DebianLike
kdcInstalled
	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))
& [Principal] -> Property DebianLike
Apt.installed [Principal
"openbsd-inetd"]
	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))
& Principal
"/etc/inetd.conf" Principal -> [Principal] -> Property UnixLike
`File.containsLines`
		[ Principal
"krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd"
		, Principal
"krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd"
		]

kpropAcls :: [String] -> Property UnixLike
kpropAcls :: [Principal] -> Property UnixLike
kpropAcls [Principal]
ps = Principal
kpropdAclPath Principal -> [Principal] -> Property UnixLike
`File.hasContent` [Principal]
ps forall p. IsProp p => p -> Principal -> p
`describe` Principal
"kprop server ACLs"

k5srvutil :: (Maybe FilePath) -> [String] -> IO String
k5srvutil :: Maybe Principal -> [Principal] -> IO Principal
k5srvutil Maybe Principal
kt [Principal]
cmd = Principal -> [Principal] -> IO Principal
readProcess Principal
"k5srvutil" (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Principal
x -> [Principal
"-f", Principal
x]) Maybe Principal
kt forall a. [a] -> [a] -> [a]
++ [Principal]
cmd)

-- Keytab management
keytabEntries :: Maybe FilePath -> IO [(Kvno, Principal)]
keytabEntries :: Maybe Principal -> IO [(Kvno, Principal)]
keytabEntries Maybe Principal
p = do
	Principal
c <- Maybe Principal -> [Principal] -> IO Principal
k5srvutil Maybe Principal
p [Principal
"list"]
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Read a => Principal -> (a, Principal)
parseLine (forall a. Int -> [a] -> [a]
drop Int
3 forall a b. (a -> b) -> a -> b
$ Principal -> [Principal]
lines Principal
c)
  where
	parseLine :: Principal -> (a, Principal)
parseLine Principal
l = (forall a. Read a => Principal -> a
Prelude.read Principal
x, Principal
y) where (Principal
x, Principal
y) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
5 Principal
l

checkKeyTabEntry' :: Maybe FilePath -> (Kvno, Principal) -> IO Bool
checkKeyTabEntry' :: Maybe Principal -> (Kvno, Principal) -> IO Bool
checkKeyTabEntry' Maybe Principal
path (Kvno, Principal)
entry = do
	[(Kvno, Principal)]
entries <- Maybe Principal -> IO [(Kvno, Principal)]
keytabEntries Maybe Principal
path
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Kvno, Principal)
entry forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Kvno, Principal)]
entries

checkKeyTabEntry :: Maybe FilePath -> Principal -> IO Bool
checkKeyTabEntry :: Maybe Principal -> Principal -> IO Bool
checkKeyTabEntry Maybe Principal
path Principal
princ = do
	[(Kvno, Principal)]
entries <- Maybe Principal -> IO [(Kvno, Principal)]
keytabEntries Maybe Principal
path
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Principal
princ forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Kvno, Principal)]
entries)

-- k5login files
k5loginPath :: User -> IO FilePath
k5loginPath :: User -> IO Principal
k5loginPath User
user = do
	Principal
h <- User -> IO Principal
homedir User
user
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Principal
h Principal -> Principal -> Principal
</> Principal
".k5login"

k5login :: User -> [Principal] -> Property UnixLike
k5login :: User -> [Principal] -> Property UnixLike
k5login user :: User
user@(User Principal
u) [Principal]
ps = forall {k} (metatypes :: k).
SingI metatypes =>
Principal
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Principal
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w -> do
	Principal
f <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ User -> IO Principal
k5loginPath User
user
	forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
		Bool -> Principal -> IO ()
createDirectoryIfMissing Bool
True (Principal -> Principal
takeDirectory Principal
f)
		Principal -> Principal -> IO ()
writeFile Principal
f ([Principal] -> Principal
unlines [Principal]
ps)
	forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Principal
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties Principal
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))
& Principal -> User -> Group -> Property UnixLike
File.ownerGroup Principal
f User
user (User -> Group
userGroup User
user)
		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))
& Principal -> User -> Group -> Property UnixLike
File.ownerGroup (Principal -> Principal
takeDirectory Principal
f) User
user (User -> Group
userGroup User
user)
  where
	desc :: Principal
desc = Principal
u forall a. [a] -> [a] -> [a]
++ Principal
" has k5login"