From 53eb3b9b1fd4df59e2b49866cbce616e43ba6ddf Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 8 Apr 2014 18:08:16 -0400
Subject: ipv6to4: Ensure interface is brought up automatically on boot.

---
 debian/changelog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'debian')

diff --git a/debian/changelog b/debian/changelog
index 4455768f..365485a3 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+propellor (0.2.4) UNRELEASED; urgency=medium
+
+  * ipv6to4: Ensure interface is brought up automatically on boot.
+
+ -- Joey Hess <joeyh@debian.org>  Tue, 08 Apr 2014 18:07:12 -0400
+
 propellor (0.2.3) unstable; urgency=medium
 
   * docker: Fix laziness bug that caused running containers to be
-- 
cgit v1.3-2-g0d8e


From 39f3acd6e473ee25e6c37fd5c8a5b4237d34127c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 8 Apr 2014 18:41:30 -0400
Subject: propellor spin

---
 Propellor/Property.hs     | 10 ++++++++++
 Propellor/Property/Apt.hs |  7 +++++--
 config-joey.hs            |  2 +-
 debian/changelog          |  2 ++
 4 files changed, 18 insertions(+), 3 deletions(-)

(limited to 'debian')

diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index e7ec704d..c2a8972e 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -33,6 +33,16 @@ combineProperties desc ps = Property desc $ go ps NoChange
 			FailedChange -> return FailedChange
 			_ -> go ls (r <> rs)
 
+-- | Combines together two properties, resulting in one property
+-- that ensures the first, and if the first succeeds, ensures the second.
+-- The property uses the description of the first property.
+before :: Property -> Property -> Property
+p1 `before` p2 = Property (propertyDesc p1) $ do
+	r <- ensureProperty p1
+	case r of
+		FailedChange -> return FailedChange
+		_ -> ensureProperty p2
+
 -- | Makes a perhaps non-idempotent Property be idempotent by using a flag
 -- file to indicate whether it has run before.
 -- Use with caution.
diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs
index 8bbb1b19..87c69dae 100644
--- a/Propellor/Property/Apt.hs
+++ b/Propellor/Property/Apt.hs
@@ -147,9 +147,12 @@ autoRemove = runApt ["-y", "autoremove"]
 
 -- | Enables unattended upgrades. Revert to disable.
 unattendedUpgrades :: RevertableProperty
-unattendedUpgrades = RevertableProperty (go True) (go False)
+unattendedUpgrades = RevertableProperty enable disable
   where
-	go enabled = (if enabled then installed else removed) ["unattended-upgrades"]
+	enable = setup True `before` installed ["cron"]
+	disable = setup False
+
+	setup enabled = (if enabled then installed else removed) ["unattended-upgrades"]
 		`onChange` reConfigure "unattended-upgrades"
 			[("unattended-upgrades/enable_auto_updates" , "boolean", v)]
 		`describe` ("unattended upgrades " ++ v)
diff --git a/config-joey.hs b/config-joey.hs
index b431a4b0..b7d9cf28 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -61,7 +61,7 @@ host _ = Nothing
 -- | This is where Docker containers are set up. A container
 -- can vary by hostname where it's used, or be the same everywhere.
 container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container)
-container parenthost name
+container _parenthost name
 	-- Simple web server, publishing the outside host's /var/www
 	| name == "webserver" = Just $ Docker.containerFrom
 		(image $ System (Debian Unstable) "amd64")
diff --git a/debian/changelog b/debian/changelog
index 365485a3..4b04fb30 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,8 @@
 propellor (0.2.4) UNRELEASED; urgency=medium
 
   * ipv6to4: Ensure interface is brought up automatically on boot.
+  * Enabling unattended upgrades now ensures that cron is installed and
+    running to perform them.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 08 Apr 2014 18:07:12 -0400
 
-- 
cgit v1.3-2-g0d8e


From 064cdd8fc575e5a16fa20bf382387560e9e4c580 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 9 Apr 2014 00:54:27 -0400
Subject: propellor spin

---
 Propellor/PrivData.hs           |   1 +
 Propellor/Property/Scheduled.hs |  58 +++++++
 TODO                            |   2 -
 Utility/QuickCheck.hs           |  52 ++++++
 Utility/Scheduled.hs            | 358 ++++++++++++++++++++++++++++++++++++++++
 config-joey.hs                  |   8 +-
 config-simple.hs                |   3 +-
 debian/changelog                |   1 +
 propellor.cabal                 |  10 +-
 9 files changed, 484 insertions(+), 9 deletions(-)
 create mode 100644 Propellor/Property/Scheduled.hs
 create mode 100644 Utility/QuickCheck.hs
 create mode 100644 Utility/Scheduled.hs

(limited to 'debian')

diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs
index e768ae9e..2897d425 100644
--- a/Propellor/PrivData.hs
+++ b/Propellor/PrivData.hs
@@ -23,6 +23,7 @@ withPrivData field a = maybe missing a =<< getPrivData field
   where
 	missing = do
 		warningMessage $ "Missing privdata " ++ show field
+		putStrLn $ "Fix this by running: propellor --set $hostname '" ++ show field ++ "'"
 		return FailedChange
 
 getPrivData :: PrivDataField -> IO (Maybe String)
diff --git a/Propellor/Property/Scheduled.hs b/Propellor/Property/Scheduled.hs
new file mode 100644
index 00000000..42ff0068
--- /dev/null
+++ b/Propellor/Property/Scheduled.hs
@@ -0,0 +1,58 @@
+module Propellor.Property.Scheduled
+	( period
+	, Recurrance(..)
+	, WeekDay
+	, MonthDay
+	, YearDay
+	) where
+
+import Propellor
+import Utility.Scheduled
+
+import Data.Time.Clock
+import Data.Time.LocalTime
+import qualified Data.Map as M
+
+-- | Makes a Property only be checked every so often.
+--
+-- This uses the description of the Property to keep track of when it was
+-- last run.
+period :: Property -> Recurrance -> Property
+period prop recurrance = Property desc $ do
+	lasttime <- getLastChecked (propertyDesc prop)
+	nexttime <- fmap startTime <$> nextTime schedule lasttime
+	t <- localNow
+	if Just t >= nexttime
+		then do
+			r <- ensureProperty prop
+			setLastChecked t (propertyDesc prop)
+			return r
+		else noChange
+  where
+	schedule = Schedule recurrance AnyTime
+	desc = propertyDesc prop ++ " (period " ++ show recurrance ++ ")"
+
+lastCheckedFile :: FilePath
+lastCheckedFile = localdir </> ".lastchecked"
+
+getLastChecked :: Desc -> IO (Maybe LocalTime)
+getLastChecked desc = M.lookup desc <$> readLastChecked
+
+localNow :: IO LocalTime
+localNow = do
+	now <- getCurrentTime
+	tz <- getTimeZone now
+	return $ utcToLocalTime tz now
+
+setLastChecked :: LocalTime -> Desc -> IO ()
+setLastChecked time desc = do
+	m <- readLastChecked
+	writeLastChecked (M.insert desc time m)
+
+readLastChecked :: IO (M.Map Desc LocalTime)
+readLastChecked = fromMaybe M.empty <$> catchDefaultIO Nothing go
+  where
+	go = readish <$> readFile lastCheckedFile
+
+writeLastChecked :: M.Map Desc LocalTime -> IO ()
+writeLastChecked = writeFile lastCheckedFile . show
diff --git a/TODO b/TODO
index 40bbd01e..a1f1c689 100644
--- a/TODO
+++ b/TODO
@@ -12,8 +12,6 @@
   says they are unchanged even when they changed and triggered a
   reprovision.
 * Should properties be a tree rather than a list?
-* Only make docker garbage collection run once a day or something
-  to avoid GC after a temp fail.
 * Need a way for a dns server host to look at the properties of 
   the other hosts and generate a zone file. For example, mapping
   openid.kitenet.net to a CNAME to clam.kitenet.net, which is where
diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs
new file mode 100644
index 00000000..7f7234c7
--- /dev/null
+++ b/Utility/QuickCheck.hs
@@ -0,0 +1,52 @@
+{- QuickCheck with additional instances
+ -
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Utility.QuickCheck
+	( module X
+	, module Utility.QuickCheck
+	) where
+
+import Test.QuickCheck as X
+import Data.Time.Clock.POSIX
+import System.Posix.Types
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Control.Applicative
+
+instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where
+	arbitrary = M.fromList <$> arbitrary
+
+instance (Arbitrary v, Eq v, Ord v) => Arbitrary (S.Set v) where
+	arbitrary = S.fromList <$> arbitrary
+
+{- Times before the epoch are excluded. -}
+instance Arbitrary POSIXTime where
+	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral
+
+instance Arbitrary EpochTime where
+	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral
+
+{- Pids are never negative, or 0. -}
+instance Arbitrary ProcessID where
+	arbitrary = arbitrarySizedBoundedIntegral `suchThat` (> 0)
+
+{- Inodes are never negative. -}
+instance Arbitrary FileID where
+	arbitrary = nonNegative arbitrarySizedIntegral
+
+{- File sizes are never negative. -}
+instance Arbitrary FileOffset where
+	arbitrary = nonNegative arbitrarySizedIntegral
+
+nonNegative :: (Num a, Ord a) => Gen a -> Gen a
+nonNegative g = g `suchThat` (>= 0)
+
+positive :: (Num a, Ord a) => Gen a -> Gen a
+positive g = g `suchThat` (> 0)
diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs
new file mode 100644
index 00000000..6b0609d8
--- /dev/null
+++ b/Utility/Scheduled.hs
@@ -0,0 +1,358 @@
+{- scheduled activities
+ - 
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Scheduled (
+	Schedule(..),
+	Recurrance(..),
+	ScheduledTime(..),
+	NextTime(..),
+	WeekDay,
+	MonthDay,
+	YearDay,
+	nextTime,
+	startTime,
+	fromSchedule,
+	fromScheduledTime,
+	toScheduledTime,
+	fromRecurrance,
+	toRecurrance,
+	toSchedule,
+	parseSchedule,
+	prop_schedule_roundtrips
+) where
+
+import Utility.Data
+import Utility.QuickCheck
+import Utility.PartialPrelude
+import Utility.Misc
+
+import Control.Applicative
+import Data.List
+import Data.Time.Clock
+import Data.Time.LocalTime
+import Data.Time.Calendar
+import Data.Time.Calendar.WeekDate
+import Data.Time.Calendar.OrdinalDate
+import Data.Tuple.Utils
+import Data.Char
+
+{- Some sort of scheduled event. -}
+data Schedule = Schedule Recurrance ScheduledTime
+  deriving (Eq, Read, Show, Ord)
+
+data Recurrance
+	= Daily
+	| Weekly (Maybe WeekDay)
+	| Monthly (Maybe MonthDay)
+	| Yearly (Maybe YearDay)
+	-- ^ Days, Weeks, or Months of the year evenly divisible by a number.
+	-- (Divisible Year is years evenly divisible by a number.)
+	| Divisible Int Recurrance
+  deriving (Eq, Read, Show, Ord)
+
+type WeekDay = Int
+type MonthDay = Int
+type YearDay = Int
+
+data ScheduledTime
+	= AnyTime
+	| SpecificTime Hour Minute
+  deriving (Eq, Read, Show, Ord)
+
+type Hour = Int
+type Minute = Int
+
+{- Next time a Schedule should take effect. The NextTimeWindow is used
+ - when a Schedule is allowed to start at some point within the window. -}
+data NextTime
+	= NextTimeExactly LocalTime
+	| NextTimeWindow LocalTime LocalTime
+  deriving (Eq, Read, Show)
+
+startTime :: NextTime -> LocalTime
+startTime (NextTimeExactly t) = t
+startTime (NextTimeWindow t _) = t
+
+nextTime :: Schedule -> Maybe LocalTime -> IO (Maybe NextTime)
+nextTime schedule lasttime = do
+	now <- getCurrentTime
+	tz <- getTimeZone now
+	return $ calcNextTime schedule lasttime $ utcToLocalTime tz now
+
+{- Calculate the next time that fits a Schedule, based on the
+ - last time it occurred, and the current time. -}
+calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
+calcNextTime (Schedule recurrance scheduledtime) lasttime currenttime
+	| scheduledtime == AnyTime = do
+		next <- findfromtoday True
+		return $ case next of
+			NextTimeWindow _ _ -> next
+			NextTimeExactly t -> window (localDay t) (localDay t)
+	| otherwise = NextTimeExactly . startTime <$> findfromtoday False
+  where
+  	findfromtoday anytime = findfrom recurrance afterday today
+	  where
+	  	today = localDay currenttime
+		afterday = sameaslastday || toolatetoday
+		toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime
+		sameaslastday = lastday == Just today
+	lastday = localDay <$> lasttime
+	nexttime = case scheduledtime of
+		AnyTime -> TimeOfDay 0 0 0
+		SpecificTime h m -> TimeOfDay h m 0
+	exactly d = NextTimeExactly $ LocalTime d nexttime
+	window startd endd = NextTimeWindow
+		(LocalTime startd nexttime)
+		(LocalTime endd (TimeOfDay 23 59 0))
+	findfrom r afterday day = case r of
+		Daily
+			| afterday -> Just $ exactly $ addDays 1 day
+			| otherwise -> Just $ exactly day
+		Weekly Nothing
+			| afterday -> skip 1
+			| otherwise -> case (wday <$> lastday, wday day) of
+				(Nothing, _) -> Just $ window day (addDays 6 day)
+				(Just old, curr)
+					| old == curr -> Just $ window day (addDays 6 day)
+					| otherwise -> skip 1
+		Monthly Nothing
+			| afterday -> skip 1
+			| maybe True (\old -> mnum day > mday old && mday day >= (mday old `mod` minmday)) lastday ->
+				-- Window only covers current month,
+				-- in case there is a Divisible requirement.
+				Just $ window day (endOfMonth day)
+			| otherwise -> skip 1
+		Yearly Nothing
+			| afterday -> skip 1
+			| maybe True (\old -> ynum day > ynum old && yday day >= (yday old `mod` minyday)) lastday ->
+				Just $ window day (endOfYear day)
+			| otherwise -> skip 1
+		Weekly (Just w)
+			| w < 0 || w > maxwday -> Nothing
+			| w == wday day -> if afterday
+				then Just $ exactly $ addDays 7 day
+				else Just $ exactly day
+			| otherwise -> Just $ exactly $
+				addDays (fromIntegral $ (w - wday day) `mod` 7) day
+		Monthly (Just m)
+			| m < 0 || m > maxmday -> Nothing
+			-- TODO can be done more efficiently than recursing
+			| m == mday day -> if afterday
+				then skip 1
+				else Just $ exactly day
+			| otherwise -> skip 1
+		Yearly (Just y)
+			| y < 0 || y > maxyday -> Nothing
+			| y == yday day -> if afterday
+				then skip 365
+				else Just $ exactly day
+			| otherwise -> skip 1
+		Divisible n r'@Daily -> handlediv n r' yday (Just maxyday)
+		Divisible n r'@(Weekly _) -> handlediv n r' wnum (Just maxwnum)
+		Divisible n r'@(Monthly _) -> handlediv n r' mnum (Just maxmnum)
+		Divisible n r'@(Yearly _) -> handlediv n r' ynum Nothing
+		Divisible _ r'@(Divisible _ _) -> findfrom r' afterday day
+	  where
+	  	skip n = findfrom r False (addDays n day)
+	  	handlediv n r' getval mmax
+			| n > 0 && maybe True (n <=) mmax =
+				findfromwhere r' (divisible n . getval) afterday day
+			| otherwise = Nothing
+	findfromwhere r p afterday day
+		| maybe True (p . getday) next = next
+		| otherwise = maybe Nothing (findfromwhere r p True . getday) next
+	  where
+		next = findfrom r afterday day
+		getday = localDay . startTime
+	divisible n v = v `rem` n == 0
+
+endOfMonth :: Day -> Day
+endOfMonth day =
+	let (y,m,_d) = toGregorian day
+	in fromGregorian y m (gregorianMonthLength y m)
+
+endOfYear :: Day -> Day
+endOfYear day =
+	let (y,_m,_d) = toGregorian day
+	in endOfMonth (fromGregorian y maxmnum 1)
+
+-- extracting various quantities from a Day
+wday :: Day -> Int
+wday = thd3 . toWeekDate
+wnum :: Day -> Int
+wnum = snd3 . toWeekDate
+mday :: Day -> Int
+mday = thd3 . toGregorian
+mnum :: Day -> Int
+mnum = snd3 . toGregorian
+yday :: Day -> Int
+yday = snd . toOrdinalDate
+ynum :: Day -> Int
+ynum = fromIntegral . fst . toOrdinalDate
+
+{- Calendar max and mins. -}
+maxyday :: Int
+maxyday = 366 -- with leap days
+minyday :: Int
+minyday = 365
+maxwnum :: Int
+maxwnum = 53 -- some years have more than 52
+maxmday :: Int
+maxmday = 31
+minmday :: Int
+minmday = 28
+maxmnum :: Int
+maxmnum = 12
+maxwday :: Int
+maxwday = 7
+
+fromRecurrance :: Recurrance -> String
+fromRecurrance (Divisible n r) =
+	fromRecurrance' (++ "s divisible by " ++ show n) r
+fromRecurrance r = fromRecurrance' ("every " ++) r
+
+fromRecurrance' :: (String -> String) -> Recurrance -> String
+fromRecurrance' a Daily = a "day"
+fromRecurrance' a (Weekly n) = onday n (a "week")
+fromRecurrance' a (Monthly n) = onday n (a "month")
+fromRecurrance' a (Yearly n) = onday n (a "year")
+fromRecurrance' a (Divisible _n r) = fromRecurrance' a r -- not used
+
+onday :: Maybe Int -> String -> String
+onday (Just n) s = "on day " ++ show n ++ " of " ++ s
+onday Nothing s = s
+
+toRecurrance :: String -> Maybe Recurrance
+toRecurrance s = case words s of
+	("every":"day":[]) -> Just Daily
+	("on":"day":sd:"of":"every":something:[]) -> withday sd something
+	("every":something:[]) -> noday something
+	("days":"divisible":"by":sn:[]) -> 
+		Divisible <$> getdivisor sn <*> pure Daily
+	("on":"day":sd:"of":something:"divisible":"by":sn:[]) -> 
+		Divisible
+			<$> getdivisor sn
+			<*> withday sd something
+	("every":something:"divisible":"by":sn:[]) -> 
+		Divisible
+			<$> getdivisor sn
+			<*> noday something
+	(something:"divisible":"by":sn:[]) -> 
+		Divisible
+			<$> getdivisor sn
+			<*> noday something
+	_ -> Nothing
+  where
+	constructor "week" = Just Weekly
+	constructor "month" = Just Monthly
+	constructor "year" = Just Yearly
+	constructor u
+		| "s" `isSuffixOf` u = constructor $ reverse $ drop 1 $ reverse u
+		| otherwise = Nothing
+  	withday sd u = do
+		c <- constructor u
+		d <- readish sd
+		Just $ c (Just d)
+	noday u = do
+		c <- constructor u
+		Just $ c Nothing
+	getdivisor sn = do
+		n <- readish sn
+		if n > 0
+			then Just n
+			else Nothing
+
+fromScheduledTime :: ScheduledTime -> String
+fromScheduledTime AnyTime = "any time"
+fromScheduledTime (SpecificTime h m) = 
+	show h' ++ (if m > 0 then ":" ++ pad 2 (show m) else "") ++ " " ++ ampm
+  where
+  	pad n s = take (n - length s) (repeat '0') ++ s
+	(h', ampm)
+		| h == 0 = (12, "AM")
+		| h < 12 = (h, "AM")
+		| h == 12 = (h, "PM")
+		| otherwise = (h - 12, "PM")
+
+toScheduledTime :: String -> Maybe ScheduledTime
+toScheduledTime "any time" = Just AnyTime
+toScheduledTime v = case words v of
+	(s:ampm:[])
+		| map toUpper ampm == "AM" ->
+			go s h0
+		| map toUpper ampm == "PM" ->
+			go s (\h -> (h0 h) + 12)
+		| otherwise -> Nothing
+	(s:[]) -> go s id
+	_ -> Nothing
+  where
+  	h0 h
+		| h == 12 = 0
+		| otherwise = h
+  	go :: String -> (Int -> Int) -> Maybe ScheduledTime
+	go s adjust =
+		let (h, m) = separate (== ':') s
+		in SpecificTime
+			<$> (adjust <$> readish h)
+			<*> if null m then Just 0 else readish m
+
+fromSchedule :: Schedule -> String
+fromSchedule (Schedule recurrance scheduledtime) = unwords
+	[ fromRecurrance recurrance
+	, "at"
+	, fromScheduledTime scheduledtime
+	]
+
+toSchedule :: String -> Maybe Schedule
+toSchedule = eitherToMaybe . parseSchedule
+
+parseSchedule :: String -> Either String Schedule
+parseSchedule s = do
+	r <- maybe (Left $ "bad recurrance: " ++ recurrance) Right
+		(toRecurrance recurrance)
+	t <- maybe (Left $ "bad time of day: " ++ scheduledtime) Right
+		(toScheduledTime scheduledtime)
+	Right $ Schedule r t
+  where
+	(rws, tws) = separate (== "at") (words s)
+	recurrance = unwords rws
+	scheduledtime = unwords tws
+
+instance Arbitrary Schedule where
+	arbitrary = Schedule <$> arbitrary <*> arbitrary
+
+instance Arbitrary ScheduledTime where
+	arbitrary = oneof
+		[ pure AnyTime
+		, SpecificTime 
+			<$> choose (0, 23)
+			<*> choose (1, 59)
+		]
+
+instance Arbitrary Recurrance where
+	arbitrary = oneof
+		[ pure Daily
+		, Weekly <$> arbday
+		, Monthly <$> arbday
+		, Yearly <$> arbday
+		, Divisible
+			<$> positive arbitrary
+			<*> oneof -- no nested Divisibles
+				[ pure Daily
+				, Weekly <$> arbday
+				, Monthly <$> arbday
+				, Yearly <$> arbday
+				]
+		]
+	  where
+	  	arbday = oneof
+			[ Just <$> nonNegative arbitrary
+			, pure Nothing
+			]
+
+prop_schedule_roundtrips :: Schedule -> Bool
+prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s
diff --git a/config-joey.hs b/config-joey.hs
index 3b796ce7..6c4507d6 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -2,6 +2,7 @@
 
 import Propellor
 import Propellor.CmdLine
+import Propellor.Property.Scheduled
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Network as Network
@@ -38,21 +39,22 @@ host hostname@"clam.kitenet.net" = standardSystem Unstable $ props
 	& JoeySites.oldUseNetshellBox
 	& Docker.docked container hostname "openid-provider"
 	& Docker.configured
-	& Docker.garbageCollected
+	& Docker.garbageCollected `period` Daily
 -- Orca is the main git-annex build box.
 host hostname@"orca.kitenet.net" = standardSystem Unstable $ props
 	& Hostname.set hostname
 	& Apt.unattendedUpgrades
 	& Docker.configured
-	& Apt.buildDep ["git-annex"]
+	& Apt.buildDep ["git-annex"] `period` Daily
 	& Docker.docked container hostname "amd64-git-annex-builder"
 	& Docker.docked container hostname "i386-git-annex-builder"
 	! Docker.docked container hostname "armel-git-annex-builder-companion"
 	! Docker.docked container hostname "armel-git-annex-builder"
-	& Docker.garbageCollected
+	& Docker.garbageCollected `period` Daily
 -- My laptop
 host _hostname@"darkstar.kitenet.net" = Just $ props
 	& Docker.configured
+	& Apt.buildDep ["git-annex"] `period` Daily
 	
 -- add more hosts here...
 --host "foo.example.com" =
diff --git a/config-simple.hs b/config-simple.hs
index 5e43b467..6784f76c 100644
--- a/config-simple.hs
+++ b/config-simple.hs
@@ -3,6 +3,7 @@
 
 import Propellor
 import Propellor.CmdLine
+import Propellor.Property.Scheduled
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Network as Network
@@ -34,7 +35,7 @@ host hostname@"mybox.example.com" = Just $ props
 	& Network.ipv6to4
 	& File.dirExists "/var/www"
 	& Docker.docked container hostname "webserver"
-	& Docker.garbageCollected
+	& Docker.garbageCollected `period` Daily
 	& Cron.runPropellor "30 * * * *"
 -- add more hosts here...
 --host "foo.example.com" =
diff --git a/debian/changelog b/debian/changelog
index 4b04fb30..d83b6ad8 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,7 @@ propellor (0.2.4) UNRELEASED; urgency=medium
   * ipv6to4: Ensure interface is brought up automatically on boot.
   * Enabling unattended upgrades now ensures that cron is installed and
     running to perform them.
+  * Properties can be scheduled to only be checked after a given time period.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 08 Apr 2014 18:07:12 -0400
 
diff --git a/propellor.cabal b/propellor.cabal
index 0869ef58..c3f4f4c0 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -38,7 +38,7 @@ Executable propellor
   GHC-Options: -Wall
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers, network, async
+   containers, network, async, time, QuickCheck
   
   if (! os(windows))
     Build-Depends: unix
@@ -48,7 +48,7 @@ Executable config
   GHC-Options: -Wall -threaded
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers, network, async
+   containers, network, async, time, QuickCheck
 
   if (! os(windows))
     Build-Depends: unix
@@ -57,7 +57,7 @@ Library
   GHC-Options: -Wall
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers, network, async
+   containers, network, async, time, QuickCheck
 
   if (! os(windows))
     Build-Depends: unix
@@ -73,6 +73,8 @@ Library
     Propellor.Property.File
     Propellor.Property.Network
     Propellor.Property.Reboot
+    Propellor.Property.Scheduled
+    Propellor.Property.Service
     Propellor.Property.Ssh
     Propellor.Property.Sudo
     Propellor.Property.Tor
@@ -103,9 +105,11 @@ Library
     Utility.PosixFiles
     Utility.Process
     Utility.SafeCommand
+    Utility.Scheduled
     Utility.ThreadScheduler
     Utility.Tmp
     Utility.UserInfo
+    Utility.QuickCheck
 
 source-repository head
   type: git
-- 
cgit v1.3-2-g0d8e


From 8852887907aeefd890720c91eb5fe5a4b6031067 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 10 Apr 2014 00:53:12 -0400
Subject: propellor spin

---
 debian/changelog | 3 +++
 1 file changed, 3 insertions(+)

(limited to 'debian')

diff --git a/debian/changelog b/debian/changelog
index d83b6ad8..ed882cf2 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -4,6 +4,9 @@ propellor (0.2.4) UNRELEASED; urgency=medium
   * Enabling unattended upgrades now ensures that cron is installed and
     running to perform them.
   * Properties can be scheduled to only be checked after a given time period.
+  * Fix bootstrapping of dependencies.
+  * Fix compilation on Debian stable.
+  * Include security updates in sources.list for stable and testing.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 08 Apr 2014 18:07:12 -0400
 
-- 
cgit v1.3-2-g0d8e


From 13a4d4889c48fc3ee44956440a87f4656da7fcc9 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 10 Apr 2014 16:03:49 -0400
Subject: Use ssh connection caching, especially when bootstrapping.

---
 Propellor/CmdLine.hs | 27 ++++++++++++++++++++-------
 TODO                 |  3 ---
 debian/changelog     |  1 +
 3 files changed, 21 insertions(+), 10 deletions(-)

(limited to 'debian')

diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs
index e4cab86c..e32ccdbe 100644
--- a/Propellor/CmdLine.hs
+++ b/Propellor/CmdLine.hs
@@ -16,6 +16,7 @@ import qualified Propellor.Property.Docker as Docker
 import qualified Propellor.Property.Docker.Shim as DockerShim
 import Utility.FileMode
 import Utility.SafeCommand
+import Utility.UserInfo
 
 usage :: IO a
 usage = do
@@ -167,9 +168,10 @@ spin host = do
 	url <- getUrl
 	void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
 	void $ boolSystem "git" [Param "push"]
-	go url =<< gpgDecrypt (privDataFile host)
+	cacheparams <- toCommand <$> sshCachingParams host
+	go cacheparams url =<< gpgDecrypt (privDataFile host)
   where
-	go url privdata = withBothHandles createProcessSuccess (proc "ssh" [user, bootstrapcmd]) $ \(toh, fromh) -> do
+	go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
 		let finish = do
 			senddata toh (privDataFile host) privDataMarker privdata
 			hClose toh
@@ -185,7 +187,7 @@ spin host = do
 				hClose toh
 				hClose fromh
 				sendGitClone host url
-				go url privdata
+				go cacheparams url privdata
 	
 	user = "root@"++host
 
@@ -221,12 +223,11 @@ spin host = do
 sendGitClone :: HostName -> String -> IO ()
 sendGitClone host url = void $ actionMessage ("Pushing git repository to " ++ host) $ do
 	branch <- getCurrentBranch
+	cacheparams <- sshCachingParams host
 	withTmpFile "propellor.git" $ \tmp _ -> allM id
-		-- TODO: ssh connection caching, or better push method
-		-- with less connections.
 		[ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]
-		, boolSystem "scp" [File tmp, Param ("root@"++host++":"++remotebundle)]
-		, boolSystem "ssh" [Param ("root@"++host), Param $ unpackcmd branch]
+		, boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++host++":"++remotebundle)]
+		, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++host), Param $ unpackcmd branch]
 		]
   where
 	remotebundle = "/usr/local/propellor.git"
@@ -341,3 +342,15 @@ checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
 			updateGlobalLogger rootLoggerName $ 
 				setLevel DEBUG .  setHandlers [f]
 	go _ = noop
+
+-- Parameters can be passed to both ssh and scp.
+sshCachingParams :: HostName -> IO [CommandParam]
+sshCachingParams hostname = do
+	home <- myHomeDir
+	let cachedir = home </> ".ssh" </> "propellor"
+	createDirectoryIfMissing False cachedir
+	let socketfile = cachedir </> hostname ++ ".sock"
+	return
+		[ Param "-o", Param ("ControlPath=" ++ socketfile)
+		, Params "-o ControlMaster=auto -o ControlPersist=yes"
+		]
diff --git a/TODO b/TODO
index 6f0de948..0cc8db1b 100644
--- a/TODO
+++ b/TODO
@@ -2,9 +2,6 @@
   run it once for the whole. For example, may want to restart apache,
   but only once despite many config changes being made to satisfy
   properties. onChange is a poor substitute.
-* --spin needs 4 ssh connections when bootstrapping a new host
-  that does not have the git repo yet. Should be possible to get that
-  down to 1.
 * Currently only Debian and derivatives are supported by most Properties.
   One way to improve that would be to parameterize Properties with a
   Distribution witness.
diff --git a/debian/changelog b/debian/changelog
index ed882cf2..55043d5b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -7,6 +7,7 @@ propellor (0.2.4) UNRELEASED; urgency=medium
   * Fix bootstrapping of dependencies.
   * Fix compilation on Debian stable.
   * Include security updates in sources.list for stable and testing.
+  * Use ssh connection caching, especially when bootstrapping.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 08 Apr 2014 18:07:12 -0400
 
-- 
cgit v1.3-2-g0d8e


From 25942fb0cca0ca90933026bf959506e099ff95a4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 10 Apr 2014 17:22:32 -0400
Subject: Propellor monad is a Reader for HostAttr

So far, the hostname is only used to improve a message in withPrivData,
but I anticipate using HostAttr for a lot more.
---
 Propellor.hs                                       |  5 +++
 Propellor/CmdLine.hs                               | 18 ++++++-----
 Propellor/Engine.hs                                | 23 +++++++++-----
 Propellor/Exception.hs                             | 16 ++++++++++
 Propellor/Message.hs                               | 25 +++++++++------
 Propellor/PrivData.hs                              | 15 ++++++---
 Propellor/Property.hs                              | 19 ++++++-----
 Propellor/Property/Cmd.hs                          |  5 ++-
 Propellor/Property/Docker.hs                       | 37 +++++++++++-----------
 Propellor/Property/File.hs                         |  4 +--
 Propellor/Property/Scheduled.hs                    | 10 +++---
 Propellor/Property/SiteSpecific/GitAnnexBuilder.hs |  5 +--
 Propellor/Property/SiteSpecific/GitHome.hs         |  2 +-
 Propellor/Property/Ssh.hs                          |  2 +-
 Propellor/Property/Sudo.hs                         |  2 +-
 Propellor/Types.hs                                 | 35 +++++++++++++++++++-
 debian/changelog                                   |  4 ++-
 propellor.cabal                                    | 12 ++++---
 18 files changed, 163 insertions(+), 76 deletions(-)
 create mode 100644 Propellor/Exception.hs

(limited to 'debian')

diff --git a/Propellor.hs b/Propellor.hs
index e39fc97d..1f1d7eca 100644
--- a/Propellor.hs
+++ b/Propellor.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PackageImports #-}
+
 -- | Pulls in lots of useful modules for building and using Properties.
 -- 
 -- Propellor enures that the system it's run in satisfies a list of
@@ -31,6 +33,7 @@ module Propellor (
 	, module Propellor.Property.Cmd
 	, module Propellor.PrivData
 	, module Propellor.Engine
+	, module Propellor.Exception
 	, module Propellor.Message
 	, localdir
 
@@ -43,6 +46,7 @@ import Propellor.Engine
 import Propellor.Property.Cmd
 import Propellor.PrivData
 import Propellor.Message
+import Propellor.Exception
 
 import Utility.PartialPrelude as X
 import Utility.Process as X
@@ -62,6 +66,7 @@ import Control.Applicative as X
 import Control.Monad as X
 import Data.Monoid as X
 import Control.Monad.IfElse as X
+import "mtl" Control.Monad.Reader as X
 
 -- | This is where propellor installs itself when deploying a host.
 localdir :: FilePath
diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs
index 6ddf8907..2026c47a 100644
--- a/Propellor/CmdLine.hs
+++ b/Propellor/CmdLine.hs
@@ -66,21 +66,23 @@ defaultMain getprops = do
 	go _ (Continue cmdline) = go False cmdline
 	go _ (Set host field) = setPrivData host field
 	go _ (AddKey keyid) = addKey keyid
-	go _ (Chain host) = withprops host $ \ps -> do
-		r <- ensureProperties' ps
+	go _ (Chain host) = withprops host $ \hostattr ps -> do
+		r <- runPropellor hostattr $ ensureProperties ps
 		putStrLn $ "\n" ++ show r
 	go _ (Docker host) = Docker.chain host
 	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
 	go True cmdline = updateFirst cmdline $ go False cmdline
-	go False (Spin host) = withprops host $ const $ spin host
+	go False (Spin host) = withprops host $ const . const $ spin host
 	go False (Run host) = ifM ((==) 0 <$> getRealUserID)
-		( onlyProcess $ withprops host ensureProperties
+		( onlyProcess $ withprops host mainProperties
 		, go True (Spin host)
 		)
 	go False (Boot host) = onlyProcess $ withprops host $ boot
 
-	withprops host a = maybe (unknownhost host) a $
+	withprops host a = maybe (unknownhost host) (a hostattr) $
 		headMaybe $ catMaybes $ map (\get -> get host) getprops
+	  where
+		hostattr = mkHostAttr host
 
 onlyProcess :: IO a -> IO a
 onlyProcess a = bracket lock unlock (const a)
@@ -275,15 +277,15 @@ fromMarked marker s
 	len = length marker
 	matches = filter (marker `isPrefixOf`) $ lines s
 
-boot :: [Property] -> IO ()
-boot ps = do
+boot :: HostAttr -> [Property] -> IO ()
+boot hostattr ps = do
 	sendMarked stdout statusMarker $ show Ready
 	reply <- hGetContentsStrict stdin
 
 	makePrivDataDir
 	maybe noop (writeFileProtected privDataLocal) $
 		fromMarked privDataMarker reply
-	ensureProperties ps
+	mainProperties hostattr ps
 
 addKey :: String -> IO ()
 addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitcommit ]
diff --git a/Propellor/Engine.hs b/Propellor/Engine.hs
index 1ae224ca..c527dc38 100644
--- a/Propellor/Engine.hs
+++ b/Propellor/Engine.hs
@@ -1,30 +1,37 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.Engine where
 
 import System.Exit
 import System.IO
 import Data.Monoid
 import System.Console.ANSI
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 import Propellor.Message
-import Utility.Exception
+import Propellor.Exception
 
-ensureProperty :: Property -> IO Result
-ensureProperty = catchDefaultIO FailedChange . propertySatisfy
+runPropellor :: HostAttr -> Propellor a -> IO a
+runPropellor hostattr a = runReaderT (runWithHostAttr a) hostattr
 
-ensureProperties :: [Property] -> IO ()
-ensureProperties ps = do
-	r <- ensureProperties' [Property "overall" $ ensureProperties' ps]
+mainProperties :: HostAttr -> [Property] -> IO ()
+mainProperties hostattr ps = do
+	r <- runPropellor hostattr $
+		ensureProperties [Property "overall" $ ensureProperties ps]
 	setTitle "propellor: done"
 	hFlush stdout
 	case r of
 		FailedChange -> exitWith (ExitFailure 1)
 		_ -> exitWith ExitSuccess
 
-ensureProperties' :: [Property] -> IO Result
-ensureProperties' ps = ensure ps NoChange
+ensureProperties :: [Property] -> Propellor Result
+ensureProperties ps = ensure ps NoChange
   where
 	ensure [] rs = return rs
 	ensure (l:ls) rs = do
 		r <- actionMessage (propertyDesc l) (ensureProperty l)
 		ensure ls (r <> rs)
+
+ensureProperty :: Property -> Propellor Result
+ensureProperty = catchPropellor . propertySatisfy
diff --git a/Propellor/Exception.hs b/Propellor/Exception.hs
new file mode 100644
index 00000000..bd9212a8
--- /dev/null
+++ b/Propellor/Exception.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE PackageImports #-}
+
+module Propellor.Exception where
+
+import qualified "MonadCatchIO-transformers" Control.Monad.CatchIO as M
+import Control.Exception
+import Control.Applicative
+
+import Propellor.Types
+
+-- | Catches IO exceptions and returns FailedChange.
+catchPropellor :: Propellor Result -> Propellor Result
+catchPropellor a = either (\_ -> FailedChange) id <$> tryPropellor a
+
+tryPropellor :: Propellor a -> Propellor (Either IOException a)
+tryPropellor = M.try
diff --git a/Propellor/Message.hs b/Propellor/Message.hs
index 5a7d8c4b..2e63061e 100644
--- a/Propellor/Message.hs
+++ b/Propellor/Message.hs
@@ -1,30 +1,35 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.Message where
 
 import System.Console.ANSI
 import System.IO
 import System.Log.Logger
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 
 -- | Shows a message while performing an action, with a colored status
 -- display.
-actionMessage :: ActionResult r => Desc -> IO r -> IO r
+actionMessage :: (MonadIO m, ActionResult r) => Desc -> m r -> m r
 actionMessage desc a = do
-	setTitle $ "propellor: " ++ desc
-	hFlush stdout
+	liftIO $ do
+		setTitle $ "propellor: " ++ desc
+		hFlush stdout
 
 	r <- a
 
-	setTitle "propellor: running"
-	let (msg, intensity, color) = getActionResult r
-	putStr $ desc ++ " ... "
-	colorLine intensity color msg
-	hFlush stdout
+	liftIO $ do
+		setTitle "propellor: running"
+		let (msg, intensity, color) = getActionResult r
+		putStr $ desc ++ " ... "
+		colorLine intensity color msg
+		hFlush stdout
 
 	return r
 
-warningMessage :: String -> IO ()
-warningMessage s = colorLine Vivid Red $ "** warning: " ++ s
+warningMessage :: MonadIO m => String -> m ()
+warningMessage s = liftIO $ colorLine Vivid Red $ "** warning: " ++ s
 
 colorLine :: ColorIntensity -> Color -> String -> IO ()
 colorLine intensity color msg = do
diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs
index 2897d425..7f5a23dc 100644
--- a/Propellor/PrivData.hs
+++ b/Propellor/PrivData.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.PrivData where
 
 import qualified Data.Map as M
@@ -7,6 +9,7 @@ import System.IO
 import System.Directory
 import Data.Maybe
 import Control.Monad
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 import Propellor.Message
@@ -18,13 +21,15 @@ import Utility.Tmp
 import Utility.SafeCommand
 import Utility.Misc
 
-withPrivData :: PrivDataField -> (String -> IO Result) -> IO Result
-withPrivData field a = maybe missing a =<< getPrivData field
+withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Result
+withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
   where
 	missing = do
-		warningMessage $ "Missing privdata " ++ show field
-		putStrLn $ "Fix this by running: propellor --set $hostname '" ++ show field ++ "'"
-		return FailedChange
+		host <- getHostName
+		liftIO $ do
+			warningMessage $ "Missing privdata " ++ show field
+			putStrLn $ "Fix this by running: propellor --set "++host++" '" ++ show field ++ "'"
+			return FailedChange
 
 getPrivData :: PrivDataField -> IO (Maybe String)
 getPrivData field = do
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index ca492e33..7af69ea8 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -1,18 +1,21 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.Property where
 
 import System.Directory
 import Control.Monad
 import Data.Monoid
 import Control.Monad.IfElse
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 import Propellor.Engine
 import Utility.Monad
 
-makeChange :: IO () -> IO Result
-makeChange a = a >> return MadeChange
+makeChange :: IO () -> Propellor Result
+makeChange a = liftIO a >> return MadeChange
 
-noChange :: IO Result
+noChange :: Propellor Result
 noChange = return NoChange
 
 -- | Combines a list of properties, resulting in a single property
@@ -20,7 +23,7 @@ noChange = return NoChange
 -- and print out the description of each as it's run. Does not stop
 -- on failure; does propigate overall success/failure.
 propertyList :: Desc -> [Property] -> Property
-propertyList desc ps = Property desc $ ensureProperties' ps
+propertyList desc ps = Property desc $ ensureProperties ps
 
 -- | Combines a list of properties, resulting in one property that
 -- ensures each in turn, stopping on failure.
@@ -49,12 +52,12 @@ p1 `before` p2 = Property (propertyDesc p1) $ do
 -- Use with caution.
 flagFile :: Property -> FilePath -> Property
 flagFile property flagfile = Property (propertyDesc property) $
-	go =<< doesFileExist flagfile
+	go =<< liftIO (doesFileExist flagfile)
   where
 	go True = return NoChange
 	go False = do
 		r <- ensureProperty property
-		when (r == MadeChange) $
+		when (r == MadeChange) $ liftIO $ 
 			unlessM (doesFileExist flagfile) $
 				writeFile flagfile ""
 		return r
@@ -76,13 +79,13 @@ infixl 1 ==>
 
 -- | Makes a Property only be performed when a test succeeds.
 check :: IO Bool -> Property -> Property
-check c property = Property (propertyDesc property) $ ifM c
+check c property = Property (propertyDesc property) $ ifM (liftIO c)
 	( ensureProperty property
 	, return NoChange
 	)
 
 boolProperty :: Desc -> IO Bool -> Property
-boolProperty desc a = Property desc $ ifM a
+boolProperty desc a = Property desc $ ifM (liftIO a)
 	( return MadeChange
 	, return FailedChange
 	)
diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs
index c715fd2a..875c1f9a 100644
--- a/Propellor/Property/Cmd.hs
+++ b/Propellor/Property/Cmd.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.Property.Cmd (
 	cmdProperty,
 	cmdProperty',
@@ -7,6 +9,7 @@ module Propellor.Property.Cmd (
 
 import Control.Applicative
 import Data.List
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 import Utility.Monad
@@ -22,7 +25,7 @@ cmdProperty cmd params = cmdProperty' cmd params []
 -- | A property that can be satisfied by running a command,
 -- with added environment.
 cmdProperty' :: String -> [String] -> [(String, String)] -> Property
-cmdProperty' cmd params env = Property desc $ do
+cmdProperty' cmd params env = Property desc $ liftIO $ do
 	env' <- addEntries env <$> getEnvironment
 	ifM (boolSystemEnv cmd (map Param params) (Just env'))
 		( return MadeChange
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index b573e641..1df34251 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -53,7 +53,7 @@ docked findc hn cn = findContainer findc hn cn $
 		    teardown = combineProperties ("undocked " ++ fromContainerId cid)
 		    	[ stoppedContainer cid
 			, Property ("cleaned up " ++ fromContainerId cid) $
-				report <$> mapM id
+				liftIO $ report <$> mapM id
 					[ removeContainer cid
 					, removeImage image
 					]
@@ -74,7 +74,7 @@ findContainer findc hn cn mk = case findc hn cn of
   where
   	cid = ContainerId hn cn
 	cantfind = containerDesc (ContainerId hn cn) $ Property "" $ do
-		warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
+		liftIO $ warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
 		return FailedChange
 
 -- | Causes *any* docker images that are not in use by running containers to
@@ -90,9 +90,9 @@ garbageCollected = propertyList "docker garbage collected"
 	]
   where
 	gccontainers = Property "docker containers garbage collected" $
-		report <$> (mapM removeContainer =<< listContainers AllContainers)
+		liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
 	gcimages = Property "docker images garbage collected" $ do
-		report <$> (mapM removeImage =<< listImages)
+		liftIO $ report <$> (mapM removeImage =<< listImages)
 
 -- | Pass to defaultMain to add docker containers.
 -- You need to provide the function mapping from
@@ -239,19 +239,19 @@ containerDesc cid p = p `describe` desc
 
 runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property
 runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc cid $ Property "running" $ do
-	l <- listContainers RunningContainers
+	l <- liftIO $ listContainers RunningContainers
 	if cid `elem` l
 		then do
 			-- Check if the ident has changed; if so the
 			-- parameters of the container differ and it must
 			-- be restarted.
-			runningident <- getrunningident
+			runningident <- liftIO $ getrunningident
 			if runningident == Just ident
-				then return NoChange
+				then noChange
 				else do
-					void $ stopContainer cid
+					void $ liftIO $ stopContainer cid
 					restartcontainer
-		else ifM (elem cid <$> listContainers AllContainers)
+		else ifM (liftIO $ elem cid <$> listContainers AllContainers)
 			( restartcontainer
 			, go image
 			)
@@ -259,8 +259,8 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
 	ident = ContainerIdent image hn cn runps
 
 	restartcontainer = do
-		oldimage <- fromMaybe image <$> commitContainer cid
-		void $ removeContainer cid
+		oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
+		void $ liftIO $ removeContainer cid
 		go oldimage
 
 	getrunningident :: IO (Maybe ContainerIdent)
@@ -280,10 +280,11 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
 		]
 	
 	go img = do
-		clearProvisionedFlag cid
-		createDirectoryIfMissing True (takeDirectory $ identFile cid)
-		shim <- Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
-		writeFile (identFile cid) (show ident)
+		liftIO $ do
+			clearProvisionedFlag cid
+			createDirectoryIfMissing True (takeDirectory $ identFile cid)
+		shim <- liftIO $ Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
+		liftIO $ writeFile (identFile cid) (show ident)
 		ensureProperty $ boolProperty "run" $ runContainer img
 			(runps ++ ["-i", "-d", "-t"])
 			[shim, "--docker", fromContainerId cid]
@@ -339,7 +340,7 @@ chain s = case toContainerId s of
 -- being run. So, retry connections to the client for up to
 -- 1 minute.
 provisionContainer :: ContainerId -> Property
-provisionContainer cid = containerDesc cid $ Property "provision" $ do
+provisionContainer cid = containerDesc cid $ Property "provision" $ liftIO $ do
 	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
 	r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
 	when (r /= FailedChange) $
@@ -372,8 +373,8 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId
 
 stoppedContainer :: ContainerId -> Property
 stoppedContainer cid = containerDesc cid $ Property desc $ 
-	ifM (elem cid <$> listContainers RunningContainers)
-		( cleanup `after` ensureProperty 
+	ifM (liftIO $ elem cid <$> listContainers RunningContainers)
+		( liftIO cleanup `after` ensureProperty 
 			(boolProperty desc $ stopContainer cid)
 		, return NoChange
 		)
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
index 64dce66f..10dee75e 100644
--- a/Propellor/Property/File.hs
+++ b/Propellor/Property/File.hs
@@ -38,10 +38,10 @@ notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $
 	makeChange $ nukeFile f
 
 fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
-fileProperty desc a f = Property desc $ go =<< doesFileExist f
+fileProperty desc a f = Property desc $ go =<< liftIO (doesFileExist f)
   where
 	go True = do
-		ls <- lines <$> readFile f
+		ls <- liftIO $ lines <$> readFile f
 		let ls' = a ls
 		if ls' == ls
 			then noChange
diff --git a/Propellor/Property/Scheduled.hs b/Propellor/Property/Scheduled.hs
index 827c648c..8341765e 100644
--- a/Propellor/Property/Scheduled.hs
+++ b/Propellor/Property/Scheduled.hs
@@ -20,13 +20,13 @@ import qualified Data.Map as M
 -- last run.
 period :: Property -> Recurrance -> Property
 period prop recurrance = Property desc $ do
-	lasttime <- getLastChecked (propertyDesc prop)
-	nexttime <- fmap startTime <$> nextTime schedule lasttime
-	t <- localNow
+	lasttime <- liftIO $ getLastChecked (propertyDesc prop)
+	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
+	t <- liftIO localNow
 	if Just t >= nexttime
 		then do
 			r <- ensureProperty prop
-			setLastChecked t (propertyDesc prop)
+			liftIO $ setLastChecked t (propertyDesc prop)
 			return r
 		else noChange
   where
@@ -38,7 +38,7 @@ periodParse :: Property -> String -> Property
 periodParse prop s = case toRecurrance s of
 	Just recurrance -> period prop recurrance
 	Nothing -> Property "periodParse" $ do
-		warningMessage $ "failed periodParse: " ++ s
+		liftIO $ warningMessage $ "failed periodParse: " ++ s
 		noChange
 
 lastCheckedFile :: FilePath
diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 580a52dc..204a9ca7 100644
--- a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -44,12 +44,13 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder"
 		let f = homedir </> "rsyncpassword"
 		if rsyncupload 
 			then withPrivData (Password builduser) $ \p -> do
-				oldp <- catchDefaultIO "" $ readFileStrict f
+				oldp <- liftIO $ catchDefaultIO "" $
+					readFileStrict f
 				if p /= oldp
 					then makeChange $ writeFile f p
 					else noChange
 			else do
-				ifM (doesFileExist f)
+				ifM (liftIO $ doesFileExist f)
 					( noChange
 					, makeChange $ writeFile f "no password configured"
 					)
diff --git a/Propellor/Property/SiteSpecific/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs
index 482100ca..1ba56b94 100644
--- a/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/Propellor/Property/SiteSpecific/GitHome.hs
@@ -8,7 +8,7 @@ import Utility.SafeCommand
 -- | Clones Joey Hess's git home directory, and runs its fixups script.
 installedFor :: UserName -> Property
 installedFor user = check (not <$> hasGitDir user) $ 
-	Property ("githome " ++ user) (go =<< homedir user)
+	Property ("githome " ++ user) (go =<< liftIO (homedir user))
 		`requires` Apt.installed ["git"]
   where
  	go Nothing = noChange
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
index 36766f56..59845f8f 100644
--- a/Propellor/Property/Ssh.hs
+++ b/Propellor/Property/Ssh.hs
@@ -53,7 +53,7 @@ uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
 	`onChange` restartSshd
   where
 	prop = Property "ssh unique host keys" $ do
-		void $ boolSystem "sh"
+		void $ liftIO $ boolSystem "sh"
 			[ Param "-c"
 			, Param "rm -f /etc/ssh/ssh_host_*"
 			]
diff --git a/Propellor/Property/Sudo.hs b/Propellor/Property/Sudo.hs
index 68b8d056..66ceb580 100644
--- a/Propellor/Property/Sudo.hs
+++ b/Propellor/Property/Sudo.hs
@@ -13,7 +13,7 @@ enabledFor :: UserName -> Property
 enabledFor user = Property desc go `requires` Apt.installed ["sudo"]
   where
 	go = do
-		locked <- isLockedPassword user
+		locked <- liftIO $ isLockedPassword user
 		ensureProperty $
 			fileProperty desc
 				(modify locked . filter (wanted locked))
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index 3be10d3f..b1632923 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -1,20 +1,53 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Propellor.Types where
 
 import Data.Monoid
+import Control.Applicative
 import System.Console.ANSI
+import "mtl" Control.Monad.Reader
+import "MonadCatchIO-transformers" Control.Monad.CatchIO
 
 type HostName = String
 type GroupName = String
 type UserName = String
 
+-- | The core data type of Propellor, this reprecents a property
+-- that the system should have, and an action to ensure it has the
+-- property.
 data Property = Property
 	{ propertyDesc :: Desc
 	-- | must be idempotent; may run repeatedly
-	, propertySatisfy :: IO Result
+	, propertySatisfy :: Propellor Result
 	}
 
+-- | A property that can be reverted.
 data RevertableProperty = RevertableProperty Property Property
 
+-- | Propellor's monad provides read-only access to attributes of the
+-- system.
+newtype Propellor a = Propellor { runWithHostAttr :: ReaderT HostAttr IO a }
+	deriving
+		( Monad
+		, Functor
+		, Applicative
+		, MonadReader HostAttr 
+		, MonadIO
+		, MonadCatchIO
+		)
+
+-- | The attributes of a system. For example, its hostname.
+newtype HostAttr = HostAttr
+	{ _hostname :: HostName
+	}
+
+mkHostAttr :: HostName -> HostAttr
+mkHostAttr = HostAttr 
+
+getHostName :: Propellor HostName
+getHostName = asks _hostname
+
 class IsProp p where
 	-- | Sets description.
 	describe :: p -> Desc -> p
diff --git a/debian/changelog b/debian/changelog
index 55043d5b..a9a142df 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,4 @@
-propellor (0.2.4) UNRELEASED; urgency=medium
+propellor (0.3.0) UNRELEASED; urgency=medium
 
   * ipv6to4: Ensure interface is brought up automatically on boot.
   * Enabling unattended upgrades now ensures that cron is installed and
@@ -8,6 +8,8 @@ propellor (0.2.4) UNRELEASED; urgency=medium
   * Fix compilation on Debian stable.
   * Include security updates in sources.list for stable and testing.
   * Use ssh connection caching, especially when bootstrapping.
+  * Properties now run in a Propellor monad, which provides access to
+    attributes of the host.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 08 Apr 2014 18:07:12 -0400
 
diff --git a/propellor.cabal b/propellor.cabal
index 03d14743..0c7e3494 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
 Name: propellor
-Version: 0.2.3
+Version: 0.3.0
 Cabal-Version: >= 1.6
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>
@@ -38,7 +38,8 @@ Executable propellor
   GHC-Options: -Wall
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers, network, async, time, QuickCheck
+   containers, network, async, time, QuickCheck, mtl,
+   MonadCatchIO-transformers
   
   if (! os(windows))
     Build-Depends: unix
@@ -48,7 +49,8 @@ Executable config
   GHC-Options: -Wall -threaded
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers, network, async, time, QuickCheck
+   containers, network, async, time, QuickCheck, mtl,
+   MonadCatchIO-transformers
 
   if (! os(windows))
     Build-Depends: unix
@@ -57,7 +59,8 @@ Library
   GHC-Options: -Wall
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers, network, async, time, QuickCheck
+   containers, network, async, time, QuickCheck, mtl,
+   MonadCatchIO-transformers
 
   if (! os(windows))
     Build-Depends: unix
@@ -88,6 +91,7 @@ Library
     Propellor.Message
     Propellor.PrivData
     Propellor.Engine
+    Propellor.Exception
     Propellor.Types
   Other-Modules:
     Propellor.CmdLine
-- 
cgit v1.3-2-g0d8e


From df9791ee2626865b29196c7ac1a5975939475a6c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 10 Apr 2014 17:50:16 -0400
Subject: deps

---
 Makefile       | 2 +-
 debian/control | 4 ++++
 2 files changed, 5 insertions(+), 1 deletion(-)

(limited to 'debian')

diff --git a/Makefile b/Makefile
index f31e5fae..e53de8c5 100644
--- a/Makefile
+++ b/Makefile
@@ -10,7 +10,7 @@ build: dist/setup-config
 	ln -sf dist/build/config/config propellor
 
 deps:
-	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev libghc-network-dev libghc-quickcheck2-dev; fi || true
+	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev libghc-network-dev libghc-quickcheck2-dev libghc-mtl-dev libghc-monadcatchio-transformers-dev; fi || true
 	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev || cabal update; cabal install async; fi || true
 
 dist/setup-config: propellor.cabal
diff --git a/debian/control b/debian/control
index 3f5cb2da..bfdc5880 100644
--- a/debian/control
+++ b/debian/control
@@ -11,6 +11,8 @@ Build-Depends:
 	libghc-unix-compat-dev,
 	libghc-ansi-terminal-dev,
 	libghc-ifelse-dev,
+	libghc-mtl-dev,
+	libghc-monadcatchio-transformers-dev,
 Maintainer: Joey Hess <joeyh@debian.org>
 Standards-Version: 3.9.5
 Vcs-Git: git://git.kitenet.net/propellor
@@ -28,6 +30,8 @@ Depends: ${misc:Depends}, ${shlibs:Depends},
 	libghc-unix-compat-dev,
 	libghc-ansi-terminal-dev,
 	libghc-ifelse-dev,
+	libghc-mtl-dev,
+	libghc-monadcatchio-transformers-dev,
 	git,
 Description: property-based host configuration management in haskell
  Propellor enures that the system it's run in satisfies a list of
-- 
cgit v1.3-2-g0d8e