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
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
keysInstalled Domain
domain = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cleanup
  where
	setup :: Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup = forall {k} (metatypes :: k).
SingI metatypes =>
Domain
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Domain
"DNSSEC keys installed" forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps forall a b. (a -> b) -> a -> b
$
		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
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cleanup = forall {k} (metatypes :: k).
SingI metatypes =>
Domain
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Domain
"DNSSEC keys removed" forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps forall a b. (a -> b) -> a -> b
$
		forall a b. (a -> b) -> [a] -> [b]
map (Domain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent 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
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
writer
			| DnsSecKey -> Bool
isPublic DnsSecKey
k = forall c s.
(IsContext c, IsPrivDataSource s) =>
s
-> Domain
-> c
-> Property
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.hasPrivContentExposedFrom
			| Bool
otherwise = forall c s.
(IsContext c, IsPrivDataSource s) =>
s
-> Domain
-> c
-> Property
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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) 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 " forall a. [a] -> [a] -> [a]
++ Domain
domain
			else Domain
"dnssec-keygen -f KSK -a RSASHA256 -b 4096 -n ZONE " 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
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
zoneSigned Domain
domain Domain
zonefile = Property
  (HasInfo
   + MetaTypes
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cleanup
  where
	setup :: Property (HasInfo + UnixLike)
	setup :: Property
  (HasInfo
   + MetaTypes
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
needupdate (Domain
-> Domain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forceZoneSigned Domain
domain Domain
zonefile)
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Domain
-> RevertableProperty
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
keysInstalled Domain
domain
	
	cleanup :: Property UnixLike
	cleanup :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cleanup = Domain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent (Domain -> Domain
signedZoneFile Domain
zonefile)
		forall x y. Combines x y => x -> y -> CombinedType x y
`before` Domain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent Domain
dssetfile
		forall x y. Combines x y => x -> y -> CombinedType x y
`before` forall setup undo.
RevertableProperty setup undo -> RevertableProperty undo setup
revert (Domain
-> RevertableProperty
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
keysInstalled Domain
domain)
	
	dssetfile :: Domain
dssetfile = Domain
dir Domain -> Domain -> Domain
</> Domain
"-" forall a. [a] -> [a] -> [a]
++ 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 <- forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO forall a b. (a -> b) -> a -> b
$ Domain -> IO UTCTime
getModificationTime (Domain -> Domain
signedZoneFile Domain
zonefile)
		case Maybe UTCTime
v of
			Maybe UTCTime
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
			Just UTCTime
t1 -> forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM (UTCTime -> Domain -> IO Bool
newerthan UTCTime
t1) forall a b. (a -> b) -> a -> b
$
				Domain
zonefile forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Domain -> DnsSecKey -> Domain
keyFn Domain
domain) [forall a. Bounded a => a
minBound..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
		forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
t2 forall a. Ord a => a -> a -> Bool
>= UTCTime
t1)

forceZoneSigned :: Domain -> FilePath -> Property UnixLike
forceZoneSigned :: Domain
-> Domain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forceZoneSigned Domain
domain Domain
zonefile = forall {k} (metatypes :: k).
SingI metatypes =>
Domain -> Propellor Result -> Property (MetaTypes metatypes)
property (Domain
"zone signed for " forall a. [a] -> [a] -> [a]
++ Domain
domain) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
	Domain
salt <- forall a. Int -> [a] -> [a]
take Int
16 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 forall a b. (a -> b) -> a -> b
$ 
		CreateProcess
p { cwd :: Maybe Domain
cwd = forall a. a -> Maybe a
Just (Domain -> Domain
takeDirectory Domain
zonefile) }
	forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (ProcessHandle -> IO Bool
checkSuccessProcess ProcessHandle
h)
		( forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
		, 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
</> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
	[ Domain
"K" forall a. [a] -> [a] -> [a]
++ 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 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 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 forall a. [a] -> [a] -> [a]
++ Domain
".signed"