summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Chroot.hs
blob: e504693778ced9fe6bd2f51b6fa6b5d55bd75d7d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
module Propellor.Property.Chroot (
	Chroot,
	chroot,
	provisioned,
) where

import Propellor
import qualified Propellor.Property.Debootstrap as Debootstrap

import qualified Data.Map as M

data Chroot = Chroot FilePath System Host

instance Hostlike Chroot where
	(Chroot l s h) & p = Chroot l s (h & p)
	(Chroot l s h) &^ p = Chroot l s (h &^ p)
	getHost (Chroot _ _ h) = h

-- | Defines a Chroot at the given location, containing the specified
-- System. Properties can be added to configure the Chroot.
--
-- > chroot "/srv/chroot/ghc-dev" (System (Debian Unstable) "amd64"
-- >    & Apt.installed ["build-essential", "ghc", "haskell-platform"]
-- >	& ...
chroot :: FilePath -> System -> Chroot
chroot location system = Chroot location system (Host location [] mempty)

-- | Ensures that the chroot exists and is provisioned according to its
-- properties.
--
-- Reverting this property removes the chroot. Note that it does not ensure
-- that any processes that might be running inside the chroot are stopped.
provisioned :: Chroot -> RevertableProperty
provisioned c@(Chroot loc system _) = RevertableProperty
	(propigateChrootInfo c (go "exists" setup))
	(go "removed" teardown)
  where
	go desc a = property ("chroot " ++ loc ++ " " ++ desc) $ do
		ensureProperties [a]

	setup = provisionChroot c `requires` built
	
	built = case system of
		(System (Debian _) _) -> debootstrap
		(System (Ubuntu _) _) -> debootstrap

	debootstrap = unrevertable (Debootstrap.built loc system [])

	teardown = undefined

propigateChrootInfo :: Chroot -> Property -> Property
propigateChrootInfo c@(Chroot loc _ h) p = propigateInfo c p (<> chrootinfo)
  where
	chrootinfo = mempty $ mempty { _chroots = M.singleton loc h }

provisionChroot :: Chroot -> Property
provisionChroot = undefined