module Propellor.Property.DnsSec where

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

-- | Puts the DNSSEC key files in place from PrivData.
--
-- signedPrimary uses this, so this property does not normally need to be
-- used directly.
keysInstalled :: Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike
keysInstalled :: Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike
keysInstalled Domain
domain = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property UnixLike
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
cleanup
  where
	setup :: Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup = Domain
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
Domain
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Domain
"DNSSEC keys installed" (Props
   (MetaTypes
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ [Property
   (MetaTypes
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property
    (MetaTypes
       '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
 -> Props
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
		(DnsSecKey
 -> Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [DnsSecKey]
-> [Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
forall a b. (a -> b) -> [a] -> [b]
map DnsSecKey
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
installkey [DnsSecKey]
keys

	cleanup :: Property UnixLike
cleanup = Domain -> Props UnixLike -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
Domain
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Domain
"DNSSEC keys removed" (Props UnixLike -> Property UnixLike)
-> Props UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ [Property UnixLike] -> Props UnixLike
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property UnixLike] -> Props UnixLike)
-> [Property UnixLike] -> Props UnixLike
forall a b. (a -> b) -> a -> b
$
		(DnsSecKey -> Property UnixLike)
-> [DnsSecKey] -> [Property UnixLike]
forall a b. (a -> b) -> [a] -> [b]
map (Domain -> Property UnixLike
File.notPresent (Domain -> Property UnixLike)
-> (DnsSecKey -> Domain) -> DnsSecKey -> Property UnixLike
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> DnsSecKey -> Domain
keyFn Domain
domain) [DnsSecKey]
keys

	installkey :: DnsSecKey
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
installkey DnsSecKey
k = PrivDataSource
-> Domain
-> Context
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
writer (DnsSecKey -> PrivDataSource
keysrc DnsSecKey
k) (Domain -> DnsSecKey -> Domain
keyFn Domain
domain DnsSecKey
k) (Domain -> Context
Context Domain
domain)
	  where
		writer :: PrivDataSource
-> Domain
-> Context
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
writer
			| DnsSecKey -> Bool
isPublic DnsSecKey
k = PrivDataSource
-> Domain
-> Context
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Domain -> c -> Property (HasInfo + UnixLike)
File.hasPrivContentExposedFrom
			| Bool
otherwise = PrivDataSource
-> Domain
-> Context
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Domain -> c -> Property (HasInfo + UnixLike)
File.hasPrivContentFrom

	keys :: [DnsSecKey]
keys = [ DnsSecKey
PubZSK, DnsSecKey
PrivZSK, DnsSecKey
PubKSK, DnsSecKey
PrivKSK ]

	keysrc :: DnsSecKey -> PrivDataSource
keysrc DnsSecKey
k = PrivDataField -> Domain -> PrivDataSource
PrivDataSource (DnsSecKey -> PrivDataField
DnsSec DnsSecKey
k) (Domain -> PrivDataSource) -> Domain -> PrivDataSource
forall a b. (a -> b) -> a -> b
$ [Domain] -> Domain
unwords
		[ Domain
"The file with extension"
		, DnsSecKey -> Domain
keyExt DnsSecKey
k
		, Domain
"created by running:"
		, if DnsSecKey -> Bool
isZoneSigningKey DnsSecKey
k
			then Domain
"dnssec-keygen -a RSASHA256 -b 2048 -n ZONE " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain
			else Domain
"dnssec-keygen -f KSK -a RSASHA256 -b 4096 -n ZONE " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain
		]

-- | Uses dnssec-signzone to sign a domain's zone file.
--
-- signedPrimary uses this, so this property does not normally need to be
-- used directly.
zoneSigned :: Domain -> FilePath -> RevertableProperty (HasInfo + UnixLike) UnixLike
zoneSigned :: Domain
-> Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike
zoneSigned Domain
domain Domain
zonefile = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
Property (HasInfo + UnixLike)
setup Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property UnixLike
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
cleanup
  where
	setup :: Property (HasInfo + UnixLike)
	setup :: Property (HasInfo + UnixLike)
setup = IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
needupdate (Domain -> Domain -> Property UnixLike
forceZoneSigned Domain
domain Domain
zonefile)
		Property UnixLike
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     UnixLike
-> CombinedType
     (Property UnixLike)
     (RevertableProperty
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
        UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike
keysInstalled Domain
domain
	
	cleanup :: Property UnixLike
	cleanup :: Property UnixLike
cleanup = Domain -> Property UnixLike
File.notPresent (Domain -> Domain
signedZoneFile Domain
zonefile)
		Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Domain -> Property UnixLike
File.notPresent Domain
dssetfile
		Property UnixLike
-> RevertableProperty
     UnixLike
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property UnixLike)
     (RevertableProperty
        UnixLike
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`before` RevertableProperty
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
  UnixLike
-> RevertableProperty
     UnixLike
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall setup undo.
RevertableProperty setup undo -> RevertableProperty undo setup
revert (Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike
keysInstalled Domain
domain)
	
	dssetfile :: Domain
dssetfile = Domain
dir Domain -> Domain -> Domain
</> Domain
"-" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
"."
	dir :: Domain
dir = Domain -> Domain
takeDirectory Domain
zonefile

	-- Need to update the signed zone file if the zone file or
	-- any of the keys have a newer timestamp.
	needupdate :: IO Bool
needupdate = do
		Maybe UTCTime
v <- IO UTCTime -> IO (Maybe UTCTime)
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (IO UTCTime -> IO (Maybe UTCTime))
-> IO UTCTime -> IO (Maybe UTCTime)
forall a b. (a -> b) -> a -> b
$ Domain -> IO UTCTime
getModificationTime (Domain -> Domain
signedZoneFile Domain
zonefile)
		case Maybe UTCTime
v of
			Maybe UTCTime
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
			Just UTCTime
t1 -> (Domain -> IO Bool) -> [Domain] -> IO Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM (UTCTime -> Domain -> IO Bool
newerthan UTCTime
t1) ([Domain] -> IO Bool) -> [Domain] -> IO Bool
forall a b. (a -> b) -> a -> b
$
				Domain
zonefile Domain -> [Domain] -> [Domain]
forall a. a -> [a] -> [a]
: (DnsSecKey -> Domain) -> [DnsSecKey] -> [Domain]
forall a b. (a -> b) -> [a] -> [b]
map (Domain -> DnsSecKey -> Domain
keyFn Domain
domain) [DnsSecKey
forall a. Bounded a => a
minBound..DnsSecKey
forall a. Bounded a => a
maxBound]

	newerthan :: UTCTime -> Domain -> IO Bool
newerthan UTCTime
t1 Domain
f = do
		UTCTime
t2 <- Domain -> IO UTCTime
getModificationTime Domain
f
		Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
t2 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
t1)

forceZoneSigned :: Domain -> FilePath -> Property UnixLike
forceZoneSigned :: Domain -> Domain -> Property UnixLike
forceZoneSigned Domain
domain Domain
zonefile = Domain -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
Domain -> Propellor Result -> Property (MetaTypes metatypes)
property (Domain
"zone signed for " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain) (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$ do
	Domain
salt <- Int -> Domain -> Domain
forall a. Int -> [a] -> [a]
take Int
16 (Domain -> Domain) -> IO Domain -> IO Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Domain
saltSha1
 	let p :: CreateProcess
p = Domain -> [Domain] -> CreateProcess
proc Domain
"dnssec-signzone"
		[ Domain
"-A"
		, Domain
"-3", Domain
salt
		-- The serial number needs to be increased each time the
		-- zone is resigned, even if there are no other changes,
		-- so that it will propagate to secondaries. So, use the
		-- unixtime serial format.
		, Domain
"-N", Domain
"unixtime"
		, Domain
"-o", Domain
domain
		, Domain
zonefile
		-- the ordering of these key files does not matter
		, Domain -> DnsSecKey -> Domain
keyFn Domain
domain DnsSecKey
PubZSK  
		, Domain -> DnsSecKey -> Domain
keyFn Domain
domain DnsSecKey
PubKSK
		]
	-- Run in the same directory as the zonefile, so it will 
	-- write the dsset file there.
	(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
h) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (CreateProcess
 -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ 
		CreateProcess
p { cwd :: Maybe Domain
cwd = Domain -> Maybe Domain
forall a. a -> Maybe a
Just (Domain -> Domain
takeDirectory Domain
zonefile) }
	IO Bool -> (IO Result, IO Result) -> IO Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (ProcessHandle -> IO Bool
checkSuccessProcess ProcessHandle
h)
		( Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
		, Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
		)

saltSha1 :: IO String
saltSha1 :: IO Domain
saltSha1 = Domain -> [Domain] -> IO Domain
readProcess Domain
"sh"
	[ Domain
"-c"
	, Domain
"head -c 1024 /dev/urandom | sha1sum | cut -d ' ' -f 1"
	]

-- | The file used for a given key.
keyFn :: Domain -> DnsSecKey -> FilePath
keyFn :: Domain -> DnsSecKey -> Domain
keyFn Domain
domain DnsSecKey
k =  Domain
"/etc/bind/propellor/dnssec" Domain -> Domain -> Domain
</> [Domain] -> Domain
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
	[ Domain
"K" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
"."
	, if DnsSecKey -> Bool
isZoneSigningKey DnsSecKey
k then Domain
"ZSK" else Domain
"KSK"
	, DnsSecKey -> Domain
keyExt DnsSecKey
k
	]

-- | These are the extensions that dnssec-keygen looks for.
keyExt :: DnsSecKey -> String
keyExt :: DnsSecKey -> Domain
keyExt DnsSecKey
k
	| DnsSecKey -> Bool
isPublic DnsSecKey
k = Domain
".key"
	| Bool
otherwise = Domain
".private"

isPublic :: DnsSecKey -> Bool
isPublic :: DnsSecKey -> Bool
isPublic DnsSecKey
k = DnsSecKey
k DnsSecKey -> [DnsSecKey] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DnsSecKey
PubZSK, DnsSecKey
PubKSK]

isZoneSigningKey :: DnsSecKey -> Bool
isZoneSigningKey :: DnsSecKey -> Bool
isZoneSigningKey DnsSecKey
k = DnsSecKey
k DnsSecKey -> [DnsSecKey] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DnsSecKey
PubZSK, DnsSecKey
PrivZSK]

-- | dnssec-signzone makes a .signed file
signedZoneFile :: FilePath -> FilePath
signedZoneFile :: Domain -> Domain
signedZoneFile Domain
zonefile = Domain
zonefile Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
".signed"