    -- | 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
    	Principal
    c <- Maybe Principal -> [Principal] -> IO Principal
    k5srvutil Maybe Principal
    p [Principal
    "list"]
    	[(Kvno, Principal)] -> IO [(Kvno, Principal)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Kvno, Principal)] -> IO [(Kvno, Principal)])
    -> [(Kvno, Principal)] -> IO [(Kvno, Principal)]
    forall a b. (a -> b) -> a -> b
    $ (Principal -> (Kvno, Principal))
    -> [Principal] -> [(Kvno, Principal)]
    forall a b. (a -> b) -> [a] -> [b]
    map Principal -> (Kvno, Principal)
    forall {a}. Read a => Principal -> (a, Principal)
    parseLine (Int -> [Principal] -> [Principal]
    forall a. Int -> [a] -> [a]
    drop Int
    3 ([Principal] -> [Principal]) -> [Principal] -> [Principal]
    forall a b. (a -> b) -> a -> b
    $ Principal -> [Principal]
    lines Principal
    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
    	[(Kvno, Principal)]
    entries <- Maybe Principal -> IO [(Kvno, Principal)]
    keytabEntries Maybe Principal
    path
    	Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ (Kvno, Principal)
    entry (Kvno, Principal) -> [(Kvno, Principal)] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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
    	Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ Principal
    princ Principal -> [Principal] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (((Kvno, Principal) -> Principal)
    -> [(Kvno, Principal)] -> [Principal]
    forall a b. (a -> b) -> [a] -> [b]
    map (Kvno, Principal) -> Principal
    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
    	Principal -> IO Principal
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Principal -> IO Principal) -> Principal -> IO Principal
    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 = 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
    	Principal
    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
    	IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    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)
    	OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Property
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> 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
       (MetaTypes
          (Combine
             '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
             '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     -> Propellor Result)
    -> Property
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ Principal
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> Property
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    forall {k} (metatypes :: k).
    SingI metatypes =>
    Principal
    -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
    combineProperties Principal
    desc (Props
       (MetaTypes
          (Combine
             '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
             '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     -> Property
          (MetaTypes
             (Combine
                '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                   'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                   'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])))
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> Property
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    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))
    & Principal -> User -> Group -> Property UnixLike
    File.ownerGroup Principal
    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))
    & 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 Principal -> Principal -> Principal
    forall a. [a] -> [a] -> [a]
    ++ Principal
    " has k5login"