summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Localdir.hs
blob: 69d9af745a33d408b314292b37637c108e15acc4 (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
58
59
60
61
62
63
64
{-# LANGUAGE DeriveDataTypeable #-}

-- | Properties to manipulate propellor's @/usr/local/propellor@ on spun hosts

module Propellor.Property.Localdir where

import Propellor.Base
import Propellor.Git.Config
import Propellor.Types.Info
import Propellor.Types.Container
import Propellor.Property.Mount (partialBindMountsOf, umountLazy)
import qualified Propellor.Property.Git as Git

-- | Sets the url to use as the origin of propellor's git repository.
--
-- By default, the url is taken from the deploy or origin remote of
-- the repository that propellor --spin is run in. Setting this property
-- overrides that default behavior with a different url.
--
-- When hosts are being updated without using -- --spin, eg when using
-- the `Propellor.Property.Cron.runPropellor` cron job, this property can
-- be set to redirect them to a new git repository url.
hasOriginUrl :: String -> Property (HasInfo + DebianLike)
hasOriginUrl u =
	setInfoProperty p (toInfo (InfoVal (OriginUrl u)))
		`requires` Git.installed
  where
	p :: Property UnixLike
	p = property ("propellor repo url " ++ u) $ do
		curru <- liftIO getRepoUrl
		if curru == Just u
			then return NoChange
			else makeChange $ setRepoUrl u

newtype OriginUrl = OriginUrl String
	deriving (Show, Typeable)

-- | Removes the @/usr/local/propellor@ directory used to spin the host, after
-- ensuring other properties.  Without this property, that directory is left
-- behind after the spin.
--
-- Does not perform other clean up, such as removing Haskell libraries that were
-- installed in order to build propellor, or removing cronjobs such as created
-- by 'Propellor.Property.Cron.runPropellor'.
removed :: Property UnixLike
removed = check (doesDirectoryExist localdir) $
	property "propellor's /usr/local dir to be removed" $ do
		endAction "removing /usr/local/propellor" atend
		return NoChange
  where
	atend _ = do
		ifM (hasContainerCapability FilesystemContained)
			-- In a chroot, all we have to do is unmount localdir,
			-- and then delete it
			( liftIO $ umountLazy localdir
			-- Outside of a chroot, if we don't unmount any bind
			-- mounts of localdir before deleting it, another run of
			-- propellor will have problems reestablishing those
			-- bind mounts in order to spin chroots
			, liftIO $ partialBindMountsOf localdir
				>>= mapM_ umountLazy
			)
		liftIO $ removeDirectoryRecursive localdir
		return NoChange