-- | 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 :: FilePath
defaultKeyTab = FilePath
"/etc/krb5.keytab"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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