-- | 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 = Principal
-> (Principal -> Principal) -> Maybe Principal -> Principal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Principal
defaultKeyTab Principal -> Principal
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 Principal -> Principal -> Principal
forall a. [a] -> [a] -> [a]
++ Principal
-> (Principal -> Principal) -> Maybe Principal -> Principal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Principal
"" (Principal
"/"Principal -> Principal -> Principal
forall a. [a] -> [a] -> [a]
++) Maybe Principal
i Principal -> Principal -> Principal
forall a. [a] -> [a] -> [a]
++ Principal
-> (Principal -> Principal) -> Maybe Principal -> Principal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Principal
"" (Principal
"@" Principal -> 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 = Principal -> Props DebianLike -> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Principal
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Principal
"kprop server installed" (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	Props UnixLike
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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
	Props DebianLike
-> Property DebianLike
-> Props
     (Sing
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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"]
	Props
  (Sing
     (Combine
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           (Combine
              '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
              '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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 Property UnixLike -> Principal -> Property UnixLike
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" ([Principal]
-> (Principal -> [Principal]) -> Maybe Principal -> [Principal]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Principal
x -> [Principal
"-f", Principal
x]) Maybe Principal
kt [Principal] -> [Principal] -> [Principal]
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
	c <- Maybe Principal -> [Principal] -> IO Principal
k5srvutil Maybe Principal
p [Principal
"list"]
	return $ map parseLine (drop 3 $ lines c)
  where
	parseLine :: Principal -> (a, Principal)
parseLine Principal
l = (Principal -> a
forall a. Read a => Principal -> a
Prelude.read Principal
x, Principal
y) where (Principal
x, Principal
y) = Int -> Principal -> (Principal, Principal)
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
	entries <- Maybe Principal -> IO [(Kvno, Principal)]
keytabEntries Maybe Principal
path
	return $ entry `elem` entries

checkKeyTabEntry :: Maybe FilePath -> Principal -> IO Bool
checkKeyTabEntry :: Maybe Principal -> Principal -> IO Bool
checkKeyTabEntry Maybe Principal
path Principal
princ = do
	entries <- Maybe Principal -> IO [(Kvno, Principal)]
keytabEntries Maybe Principal
path
	return $ princ `elem` (map snd entries)

-- k5login files
k5loginPath :: User -> IO FilePath
k5loginPath :: User -> IO Principal
k5loginPath User
user = do
	h <- User -> IO Principal
homedir User
user
	return $ h </> ".k5login"

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