Merge branch 'master' into joeyconfig

24 files changed, 378 insertions, 55 deletions

diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 2c8fa95a..045e5256 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -60,6 +60,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
   where
 	osinstall = case msys of
 		Just (System (FreeBSD _) _) -> map pkginstall fbsddeps
+		Just (System (ArchLinux) _) -> map pacmaninstall archlinuxdeps
 		Just (System (Debian _ _) _) -> useapt
 		Just (System (Buntish _) _) -> useapt
 		-- assume a debian derived system when not specified
@@ -74,6 +75,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 
 	aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
 	pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
+	pacmaninstall p = "pacman -S --noconfirm --needed " ++ p
 
 	-- This is the same deps listed in debian/control.
 	debdeps =
@@ -112,6 +114,25 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 		, "hs-text"
 		, "gmake"
 		]
+	archlinuxdeps =
+		[ "gnupg"
+		, "ghc"
+		, "cabal-install"
+		, "haskell-async"
+		, "haskell-missingh"
+		, "haskell-hslogger"
+		, "haskell-unix-compat"
+		, "haskell-ansi-terminal"
+		, "haskell-hackage-security"
+		, "haskell-ifelse"
+		, "haskell-network"
+		, "haskell-mtl"
+		, "haskell-transformers-base"
+		, "haskell-exceptions"
+		, "haskell-stm"
+		, "haskell-text"
+		, "make"
+		]
 
 installGitCommand :: Maybe System -> ShellCommand
 installGitCommand msys = case msys of
@@ -121,6 +142,8 @@ installGitCommand msys = case msys of
 		[ "ASSUME_ALWAYS_YES=yes pkg update"
 		, "ASSUME_ALWAYS_YES=yes pkg install git"
 		]
+	(Just (System (ArchLinux) _)) -> use
+		[ "pacman -S --noconfirm --needed git"]
 	-- assume a debian derived system when not specified
 	Nothing -> use apt
   where
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index c407fce8..a36ec7f5 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -24,22 +24,36 @@ import Utility.FileSystemEncoding
 usage :: Handle -> IO ()
 usage h = hPutStrLn h $ unlines
 	[ "Usage:"
-	, "  propellor --init"
-	, "  propellor"
-	, "  propellor hostname"
-	, "  propellor --spin targethost [--via relayhost]"
-	, "  propellor --add-key keyid"
-	, "  propellor --rm-key keyid"
-	, "  propellor --list-fields"
-	, "  propellor --dump field context"
-	, "  propellor --edit field context"
-	, "  propellor --set field context"
-	, "  propellor --unset field context"
-	, "  propellor --unset-unused"
-	, "  propellor --merge"
-	, "  propellor --build"
-	, "  propellor --check"
-	]
+	, "  with no arguments, provision the current host"
+	, ""
+	, "  --init"
+	, "      initialize ~/.propellor"
+	, "  hostname"
+	, "      provision the current host as if it had the specified hostname"
+	, "  --spin targethost [--via relayhost]"
+	, "      provision the specified host"
+	, "  --build"
+	, "      recompile using your current config"
+	, "  --add-key keyid"
+	, "      add an additional signing key to the private data"
+	, "  --rm-key keyid"
+	, "      remove a signing key from the private data"
+	, "  --list-fields"
+	, "      list private data fields"
+	, "  --set field context"
+	, "      set a private data field"
+	, "  --unset field context"
+	, "      clear a private data field"
+	, "  --unset-unused"
+	, "      clear unused fields from the private data"
+	, "  --dump field context"
+	, "      show the content of a private data field"
+	, "  --edit field context"
+	, "      edit the content of a private data field"
+	, "  --merge"
+	, "      combine multiple spins into a single git commit"
+	, "  --check"
+	, "      double-check that propellor can actually run here"]
 
 usageError :: [String] -> IO a
 usageError ps = do
@@ -55,6 +69,7 @@ processCmdLine = go =<< getArgs
 			<$> mapM hostname (reverse hs)
 			<*> pure (Just r)
 		_ -> Spin <$> mapM hostname ps <*> pure Nothing
+	go ("--build":[]) = return Build
 	go ("--add-key":k:[]) = return $ AddKey k
 	go ("--rm-key":k:[]) = return $ RmKey k
 	go ("--set":f:c:[]) = withprivfield f c Set
@@ -104,6 +119,7 @@ defaultMain hostlist = withConcurrentOutput $ do
   where
 	go cr (Serialized cmdline) = go cr cmdline
 	go _ Check = return ()
+	go cr Build = buildFirst Nothing cr Build $ return ()
 	go _ (Set field context) = setPrivData field context
 	go _ (Unset field context) = unsetPrivData field context
 	go _ (UnsetUnused) = unsetPrivDataUnused hostlist
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 3d7f07a5..49ca689f 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -3,6 +3,7 @@
 module Propellor.Info (
 	osDebian,
 	osBuntish,
+	osArchLinux,
 	osFreeBSD,
 	setInfoProperty,
 	addInfoProperty,
@@ -106,6 +107,10 @@ osBuntish release arch = tightenTargets $ os (System (Buntish release) arch)
 osFreeBSD :: FreeBSDRelease -> Architecture -> Property (HasInfo + FreeBSD)
 osFreeBSD release arch = tightenTargets $ os (System (FreeBSD release) arch)
 
+-- | Specifies that a host's operating system is Arch Linux
+osArchLinux :: Architecture -> Property (HasInfo + ArchLinux)
+osArchLinux arch = tightenTargets $ os (System (ArchLinux) arch)
+
 os :: System -> Property (HasInfo + UnixLike)
 os system = pureInfoProperty ("Operating " ++ show system) (InfoVal system)
 
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 06145333..7860a3df 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -308,8 +308,8 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
 --
 -- > myproperty :: Property Debian
 -- > myproperty = withOS "foo installed" $ \w o -> case o of
--- > 	(Just (System (Debian (Stable release)) arch)) -> ensureProperty w ...
--- > 	(Just (System (Debian suite) arch)) -> ensureProperty w ...
+-- > 	(Just (System (Debian kernel (Stable release)) arch)) -> ensureProperty w ...
+-- > 	(Just (System (Debian kernel suite) arch)) -> ensureProperty w ...
 -- >	_ -> unsupportedOS'
 --
 -- Note that the operating system specifics may not be declared for all hosts,
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 196fb345..9a55c367 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -62,10 +62,7 @@ binandsrc url suite = catMaybes
 		return $ debLine bs url stdSections
 
 debCdn :: SourcesGenerator
-debCdn = binandsrc "http://httpredir.debian.org/debian"
-
-kernelOrg :: SourcesGenerator
-kernelOrg = binandsrc "http://mirrors.kernel.org/debian"
+debCdn = binandsrc "http://deb.debian.org/debian"
 
 -- | Only available for Stable and Testing
 securityUpdates :: SourcesGenerator
@@ -77,9 +74,6 @@ securityUpdates suite
 
 -- | Makes sources.list have a standard content using the Debian mirror CDN,
 -- with the Debian suite configured by the os.
---
--- Since the CDN is sometimes unreliable, also adds backup lines using
--- kernel.org.
 stdSourcesList :: Property Debian
 stdSourcesList = withOS "standard sources.list" $ \w o -> case o of
 	(Just (System (Debian _ suite) _)) ->
@@ -98,7 +92,56 @@ stdSourcesList' suite more = tightenTargets $ setSourcesList
 	(concatMap (\gen -> gen suite) generators)
 	`describe` ("standard sources.list for " ++ show suite)
   where
-	generators = [debCdn, kernelOrg, securityUpdates] ++ more
+	generators = [debCdn, securityUpdates] ++ more
+
+type PinPriority = Int
+
+-- | Adds an apt source for a suite, and pins that suite to a given pin value
+-- (see apt_preferences(5)).  Revert to drop the source and unpin the suite.
+--
+-- If the requested suite is the host's OS suite, the suite is pinned, but no
+-- source is added.  That apt source should already be available, or you can use
+-- a property like 'Apt.stdSourcesList'.
+suiteAvailablePinned
+	:: DebianSuite
+	-> PinPriority
+	-> RevertableProperty Debian Debian
+suiteAvailablePinned s pin = available <!> unavailable
+  where
+	available :: Property Debian
+	available = tightenTargets $ combineProperties (desc True) $ props
+		& File.hasContent prefFile (suitePinBlock "*" s pin)
+		& setSourcesFile
+
+	unavailable :: Property Debian
+	unavailable = tightenTargets $ combineProperties (desc False) $ props
+		& File.notPresent sourcesFile
+			`onChange` update
+		& File.notPresent prefFile
+
+	setSourcesFile :: Property Debian
+	setSourcesFile = withOS (desc True) $ \w o -> case o of
+			(Just (System (Debian _ hostSuite) _))
+				| s /= hostSuite -> ensureProperty w $
+					File.hasContent sourcesFile sources
+					`onChange` update
+			_ -> noChange
+
+	-- Unless we are pinning a backports suite, filter out any backports
+	-- sources that were added by our generators.  The user probably doesn't
+	-- want those to be pinned to the same value
+	sources = dropBackports $ concatMap (\gen -> gen s) generators
+	  where
+		dropBackports
+			| "-backports" `isSuffixOf` (showSuite s) = id
+			| otherwise = filter (not . isInfixOf "-backports")
+
+	generators = [debCdn, securityUpdates]
+	prefFile = "/etc/apt/preferences.d/20" ++ showSuite s ++ ".pref"
+	sourcesFile = "/etc/apt/sources.list.d/" ++ showSuite s ++ ".list"
+
+	desc True = "Debian " ++ showSuite s ++ " pinned, priority " ++ show pin
+	desc False = "Debian " ++ showSuite s ++ " not pinned"
 
 setSourcesList :: [Line] -> Property DebianLike
 setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
@@ -196,6 +239,50 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
   where
 	cmd = "cd '" ++ dir ++ "' && mk-build-deps debian/control --install --tool 'apt-get -y --no-install-recommends' --remove"
 
+-- | The name of a package, a glob to match the names of packages, or a regexp
+-- surrounded by slashes to match the names of packages.  See
+-- apt_preferences(5), "Regular expressions and glob(7) syntax"
+type AptPackagePref = String
+
+-- | Pins a list of packages, package wildcards and/or regular expressions to a
+-- list of suites and corresponding pin priorities (see apt_preferences(5)).
+-- Revert to unpin.
+--
+-- Each package, package wildcard or regular expression will be pinned to all of
+-- the specified suites.
+--
+-- Note that this will have no effect unless there is an apt source for each of
+-- the suites.  One way to add an apt source is 'Apt.suiteAvailablePinned'.
+--
+-- For example, to obtain Emacs Lisp addon packages not present in your release
+-- of Debian from testing, falling back to sid if they're not available in
+-- testing, you could use
+--
+--  > & Apt.suiteAvailablePinned Testing (-10)
+--  > & Apt.suiteAvailablePinned Unstable (-10)
+--  > & ["elpa-*"] `Apt.pinnedTo` [(Testing, 100), (Unstable, 50)]
+pinnedTo
+	:: [AptPackagePref]
+	-> [(DebianSuite, PinPriority)]
+	-> RevertableProperty Debian Debian
+pinnedTo ps pins = (\p -> pinnedTo' p pins) `applyToList` ps
+	`describe` unwords (("pinned to " ++ showSuites):ps)
+  where
+	showSuites = intercalate "," $ showSuite . fst <$> pins
+
+pinnedTo'
+	:: AptPackagePref
+	-> [(DebianSuite, PinPriority)]
+	-> RevertableProperty Debian Debian
+pinnedTo' p pins =
+	(tightenTargets $ prefFile `File.hasContent` prefs)
+	<!> (tightenTargets $ File.notPresent prefFile)
+  where
+	prefs = foldr step [] pins
+	step (suite, pin) ls = ls ++ suitePinBlock p suite pin ++ [""]
+	prefFile = "/etc/apt/preferences.d/10propellor_"
+		++ File.configFileName p <.> "pref"
+
 -- | Package installation may fail becuse the archive has changed.
 -- Run an update in that case and retry.
 robustly :: Property DebianLike -> Property DebianLike
@@ -349,5 +436,24 @@ hasForeignArch arch = check notAdded (add `before` update)
 	add = cmdProperty "dpkg" ["--add-architecture", arch]
 		`assume` MadeChange
 
+-- | Disable the use of PDiffs for machines with high-bandwidth connections.
+noPDiffs :: Property DebianLike
+noPDiffs = tightenTargets $ "/etc/apt/apt.conf.d/20pdiffs" `File.hasContent`
+	[ "Acquire::PDiffs \"false\";" ]
+
+suitePin :: DebianSuite -> String
+suitePin s = prefix s ++ showSuite s
+  where
+	prefix (Stable _) = "n="
+	prefix _ = "a="
+
+suitePinBlock :: AptPackagePref -> DebianSuite -> PinPriority -> [Line]
+suitePinBlock p suite pin =
+	[ "Explanation: This file added by propellor"
+	, "Package: " ++ p
+	, "Pin: release " ++ suitePin suite
+	, "Pin-Priority: " ++ show pin
+	]
+
 dpkgStatus :: FilePath
 dpkgStatus = "/var/lib/dpkg/status"
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index cb693a73..5f2e6b32 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -93,6 +93,7 @@ instance ChrootBootstrapper Debootstrapped where
 	buildchroot (Debootstrapped cf) system loc = case system of
 		(Just s@(System (Debian _ _) _)) -> Right $ debootstrap s
 		(Just s@(System (Buntish _) _)) -> Right $ debootstrap s
+		(Just (System ArchLinux _)) -> Left "Arch Linux not supported by debootstrap."
 		(Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap."
 		Nothing -> Left "Cannot debootstrap; OS not specified"
 	  where
diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
index d8a9c423..ad15f9a2 100644
--- a/src/Propellor/Property/DebianMirror.hs
+++ b/src/Propellor/Property/DebianMirror.hs
@@ -79,7 +79,7 @@ data DebianMirror = DebianMirror
 
 mkDebianMirror :: FilePath -> Cron.Times -> DebianMirror
 mkDebianMirror dir crontimes = DebianMirror
-	{ _debianMirrorHostName = "httpredir.debian.org"
+	{ _debianMirrorHostName = "deb.debian.org"
 	, _debianMirrorDir = dir
 	, _debianMirrorSuites = []
 	, _debianMirrorArchitectures = []
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index db114e01..e21bcdff 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -96,6 +96,7 @@ built' installprop target system@(System _ arch) config =
 extractSuite :: System -> Maybe String
 extractSuite (System (Debian _ s) _) = Just $ Apt.showSuite s
 extractSuite (System (Buntish r) _) = Just r
+extractSuite (System (ArchLinux) _) = Nothing
 extractSuite (System (FreeBSD _) _) = Nothing
 
 -- | Ensures debootstrap is installed.
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 06dfa69c..c828211b 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -81,16 +81,16 @@ type DiskImage = FilePath
 -- chroot while the disk image is being built, which should prevent any
 -- daemons that are included from being started on the system that is
 -- building the disk image.
-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
 imageBuilt = imageBuilt' False
 
 -- | Like 'built', but the chroot is deleted and rebuilt from scratch each
 -- time. This is more expensive, but useful to ensure reproducible results
 -- when the properties of the chroot have been changed.
-imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
 imageRebuilt = imageBuilt' True
 
-imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
 imageBuilt' rebuild img mkchroot tabletype final partspec =
 	imageBuiltFrom img chrootdir tabletype final partspec
 		`requires` Chroot.provisioned chroot
@@ -124,7 +124,7 @@ cachesCleaned = "cache cleaned" ==> (Apt.cacheCleaned `pickOS` skipit)
 	skipit = doNothing :: Property UnixLike
 
 -- | Builds a disk image from the contents of a chroot.
-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) UnixLike
+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) UnixLike
 imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
   where
 	desc = img ++ " built from " ++ chrootdir
@@ -150,7 +150,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
 		imageFinalized final mnts mntopts devs parttable
 	rmimg = File.notPresent img
 
-partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux
+partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property DebianLike
 partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
 	mconcat $ zipWith3 (go w) mnts mntopts devs
   where
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 2ef97438..0bfcc781 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -55,6 +55,7 @@ import Propellor.Container
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Cmd as Cmd
+import qualified Propellor.Property.Pacman as Pacman
 import qualified Propellor.Shim as Shim
 import Utility.Path
 import Utility.ThreadScheduler
@@ -68,8 +69,8 @@ import Data.List.Utils
 import qualified Data.Map as M
 import System.Console.Concurrent
 
-installed :: Property DebianLike
-installed = Apt.installed ["docker.io"]
+installed :: Property (DebianLike + ArchLinux)
+installed = Apt.installed ["docker.io"] `pickOS` Pacman.installed ["docker"]
 
 -- | Configures docker with an authentication file, so that images can be
 -- pushed to index.docker.io. Optional.
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 95fc6f81..869fa48b 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -6,8 +6,10 @@ import Propellor.Base
 import Utility.FileMode
 
 import qualified Data.ByteString.Lazy as L
+import Data.List (isInfixOf, isPrefixOf)
 import System.Posix.Files
 import System.Exit
+import Data.Char
 
 type Line = String
 
@@ -21,11 +23,33 @@ f `hasContent` newcontent = fileProperty
 containsLine :: FilePath -> Line -> Property UnixLike
 f `containsLine` l = f `containsLines` [l]
 
+-- | Ensures that a list of lines are present in a file, adding any that are not
+-- to the end of the file.
+--
+-- Note that this property does not guarantee that the lines will appear
+-- consecutively, nor in the order specified.  If you need either of these, use
+-- 'File.containsBlock'.
 containsLines :: FilePath -> [Line] -> Property UnixLike
 f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
   where
 	go content = content ++ filter (`notElem` content) ls
 
+-- | Ensures that a block of consecutive lines is present in a file, adding it
+-- to the end if not.  Revert to ensure that the block is not present (though
+-- the lines it contains could be present, non-consecutively).
+containsBlock :: FilePath -> [Line] -> RevertableProperty UnixLike UnixLike
+f `containsBlock` ls =
+	fileProperty (f ++ " contains block:" ++ show ls) add f
+	<!> fileProperty (f ++ " lacks block:" ++ show ls) remove f
+  where
+	add content
+		| ls `isInfixOf` content = content
+		| otherwise              = content ++ ls
+	remove [] = []
+	remove content@(x:xs)
+		| ls `isPrefixOf` content = remove (drop (length ls) content)
+		| otherwise = x : remove xs
+
 -- | Ensures that a line is not present in a file.
 -- Note that the file is ensured to exist, so if it doesn't, an empty
 -- file will be written.
@@ -221,3 +245,42 @@ viaStableTmp a f = bracketIO setup cleanup go
 	go tmpfile = do
 		a tmpfile
 		liftIO $ rename tmpfile f
+
+-- | Generates a base configuration file name from a String, which
+-- can be put in a configuration directory, such as
+-- </etc/apt/sources.list.d/>
+--
+-- The generated file name is limited to using ASCII alphanumerics,
+-- \'_\' and \'.\' , so that programs that only accept a limited set of
+-- characters will accept it. Any other characters will be encoded
+-- in escaped form.
+--
+-- Some file extensions, such as ".old" may be filtered out by
+-- programs that use configuration directories. To avoid such problems,
+-- it's a good idea to add an static prefix and extension to the 
+-- result of this function. For example:
+--
+-- > aptConf foo = "/etc/apt/apt.conf.d" </> "propellor_" ++ configFileName foo <.> ".conf"
+configFileName :: String -> FilePath
+configFileName = concatMap escape
+  where
+	escape c
+		| isAscii c && isAlphaNum c = [c]
+		| c == '.' = [c]
+		| otherwise = '_' : show (ord c)
+
+-- | Applies configFileName to any value that can be shown.
+showConfigFileName :: Show v => v -> FilePath
+showConfigFileName = configFileName . show
+
+-- | Inverse of showConfigFileName.
+readConfigFileName :: Read v => FilePath -> Maybe v
+readConfigFileName = readish . unescape
+  where
+	unescape [] = []
+	unescape ('_':cs) = case break (not . isDigit) cs of
+		([], _) -> '_' : unescape cs
+		(ns, cs') -> case readish ns of
+			Nothing -> '_' : ns ++ unescape cs'
+			Just n -> chr n : unescape cs'
+	unescape (c:cs) = c : unescape cs
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index d974cfbc..10d7afc0 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -64,7 +64,7 @@ import Control.Exception (throw)
 -- > & User.accountFor "joey"
 -- > & User.hasSomePassword "joey"
 -- > -- rest of system properties here
-cleanInstallOnce :: Confirmation -> Property Linux
+cleanInstallOnce :: Confirmation -> Property DebianLike
 cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 	go `requires` confirmed "clean install confirmed" confirmation
   where
diff --git a/src/Propellor/Property/Pacman.hs b/src/Propellor/Property/Pacman.hs
new file mode 100644
index 00000000..60ed4bea
--- /dev/null
+++ b/src/Propellor/Property/Pacman.hs
@@ -0,0 +1,68 @@
+-- | Maintainer: Zihao Wang <dev@wzhd.org>
+--
+-- Support for the Pacman package manager <https://www.archlinux.org/pacman/>
+
+module Propellor.Property.Pacman where
+
+import Propellor.Base
+
+runPacman :: [String] -> UncheckedProperty ArchLinux
+runPacman ps = tightenTargets $ cmdProperty "pacman" ps
+
+-- | Have pacman update its lists of packages, but without upgrading anything.
+update :: Property ArchLinux
+update =  combineProperties ("pacman update") $ props
+	& runPacman ["-Sy", "--noconfirm"]
+		`assume` MadeChange
+
+upgrade :: Property ArchLinux
+upgrade = combineProperties ("pacman upgrade") $ props
+	& runPacman ["-Syu", "--noconfirm"]
+		`assume` MadeChange
+
+type Package = String
+
+installed :: [Package] -> Property ArchLinux
+installed = installed' ["--noconfirm"]
+
+installed' :: [String] -> [Package] -> Property ArchLinux
+installed' params ps = check (not <$> isInstalled' ps) go
+	`describe` unwords ("pacman installed":ps)
+  where
+	go = runPacman (params ++ ["-S"] ++ ps)
+
+removed :: [Package] -> Property ArchLinux
+removed ps = check (any (== IsInstalled) <$> getInstallStatus ps)
+	(runPacman (["-R", "--noconfirm"] ++ ps))
+	`describe` unwords ("pacman removed":ps)
+
+isInstalled :: Package -> IO Bool
+isInstalled p = isInstalled' [p]
+
+isInstalled' :: [Package] -> IO Bool
+isInstalled' ps = all (== IsInstalled) <$> getInstallStatus ps
+
+data InstallStatus = IsInstalled | NotInstalled
+	deriving (Show, Eq)
+
+{- Returns the InstallStatus of packages that are installed
+ - or known and not installed. If a package is not known at all to apt
+ - or dpkg, it is not included in the list. -}
+getInstallStatus :: [Package] -> IO [InstallStatus]
+getInstallStatus ps = mapMaybe id <$> mapM status ps
+  where
+	status :: Package -> IO (Maybe InstallStatus)
+	status p = do
+	  ifM (succeeds "pacman" ["-Q", p])
+	    (return (Just IsInstalled),
+	      ifM (succeeds "pacman" ["-Sp", p])
+	        (return (Just NotInstalled),
+	         return Nothing))
+
+succeeds :: String -> [String] -> IO Bool
+succeeds cmd args = (quietProcess >> return True)
+	`catchIO` (\_ -> return False)
+  where
+	quietProcess :: IO ()
+	quietProcess = withQuietOutput createProcessSuccess p
+	p = (proc cmd args)
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index bc8a256d..40af3357 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -23,6 +23,7 @@ module Propellor.Property.Parted (
 
 import Propellor.Base
 import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Pacman as Pacman
 import qualified Propellor.Property.Partition as Partition
 import Utility.DataUnits
 import Data.Char
@@ -192,12 +193,12 @@ partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do
 --
 -- Parted is run in script mode, so it will never prompt for input.
 -- It is asked to use cylinder alignment for the disk.
-parted :: Eep -> FilePath -> [String] -> Property DebianLike
+parted :: Eep -> FilePath -> [String] -> Property (DebianLike + ArchLinux)
 parted YesReallyDeleteDiskContents disk ps = p `requires` installed
   where
 	p = cmdProperty "parted" ("--script":"--align":"cylinder":disk:ps)
 		`assume` MadeChange
 
 -- | Gets parted installed.
-installed :: Property DebianLike
-installed = Apt.installed ["parted"]
+installed :: Property (DebianLike + ArchLinux)
+installed = Apt.installed ["parted"] `pickOS` Pacman.installed ["parted"]
diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs
index 31731dc2..3781cd7b 100644
--- a/src/Propellor/Property/Reboot.hs
+++ b/src/Propellor/Property/Reboot.hs
@@ -59,7 +59,7 @@ atEnd force resultok = property "scheduled reboot at end of propellor run" $ do
 -- See 'Propellor.Property.HostingProvider.DigitalOcean'
 -- for an example of how to do this.
 toDistroKernel :: Property DebianLike
-toDistroKernel = check (not <$> runningInstalledKernel) now
+toDistroKernel = tightenTargets $ check (not <$> runningInstalledKernel) now
 	`describe` "running installed kernel"
 
 -- | Given a kernel version string @v@, reboots immediately if the running
diff --git a/src/Propellor/Property/Rsync.hs b/src/Propellor/Property/Rsync.hs
index b40396de..53baa74e 100644
--- a/src/Propellor/Property/Rsync.hs
+++ b/src/Propellor/Property/Rsync.hs
@@ -2,6 +2,7 @@ module Propellor.Property.Rsync where
 
 import Propellor.Base
 import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Pacman as Pacman
 
 type Src = FilePath
 type Dest = FilePath
@@ -16,7 +17,7 @@ filesUnder d = Pattern (d ++ "/*")
 
 -- | Ensures that the Dest directory exists and has identical contents as
 -- the Src directory.
-syncDir :: Src -> Dest -> Property DebianLike
+syncDir :: Src -> Dest -> Property (DebianLike + ArchLinux)
 syncDir = syncDirFiltered []
 
 data Filter 
@@ -43,7 +44,7 @@ newtype Pattern = Pattern String
 -- Rsync checks each name to be transferred against its list of Filter
 -- rules, and the first matching one is acted on. If no matching rule
 -- is found, the file is processed.
-syncDirFiltered :: [Filter] -> Src -> Dest -> Property DebianLike
+syncDirFiltered :: [Filter] -> Src -> Dest -> Property (DebianLike + ArchLinux)
 syncDirFiltered filters src dest = rsync $
 	[ "-av"
 	-- Add trailing '/' to get rsync to sync the Dest directory,
@@ -56,7 +57,7 @@ syncDirFiltered filters src dest = rsync $
 	, "--quiet"
 	] ++ map toRsync filters
 
-rsync :: [String] -> Property DebianLike
+rsync :: [String] -> Property (DebianLike + ArchLinux)
 rsync ps = cmdProperty "rsync" ps
 	`assume` MadeChange
-	`requires` Apt.installed ["rsync"]
+	`requires` Apt.installed ["rsync"] `pickOS` Pacman.installed ["rsync"]
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index c3e55bbf..db5982cd 100644
--- a/src/Propellor/Property/Sbuild.hs
+++ b/src/Propellor/Property/Sbuild.hs
@@ -501,7 +501,7 @@ schrootFromSystem system@(System _ arch) =
 	>>= \suite -> return $ SbuildSchroot suite arch
 
 stdMirror :: System -> Maybe Apt.Url
-stdMirror (System (Debian _ _) _) = Just "http://httpredir.debian.org/debian"
+stdMirror (System (Debian _ _) _) = Just "http://deb.debian.org/debian"
 stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/"
 stdMirror _ = Nothing
 
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 4f8b48af..445bce07 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -892,7 +892,7 @@ userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
 -- <http://joeyh.name/blog/entry/a_programmable_alarm_clock_using_systemd/>
 --
 -- oncalendar example value: "*-*-* 7:30"
-alarmClock :: String -> User -> String -> Property DebianLike
+alarmClock :: String -> User -> String -> Property Linux
 alarmClock oncalendar (User user) command = combineProperties "goodmorning timer installed" $ props
 	& "/etc/systemd/system/goodmorning.timer" `File.hasContent`
 		[ "[Unit]"
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index ea9f39ed..db71c87a 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -124,22 +124,30 @@ bandwidthRate' s divby = case readSize dataUnits s of
 -- If used without `hiddenServiceData`, tor will generate a new
 -- private key.
 hiddenService :: HiddenServiceName -> Port -> Property DebianLike
-hiddenService hn (Port port) = ConfFile.adjustSection
-	(unwords ["hidden service", hn, "available on port", show port])
+hiddenService hn port = hiddenService' hn [port]
+
+hiddenService' :: HiddenServiceName -> [Port] -> Property DebianLike
+hiddenService' hn ports = ConfFile.adjustSection
+	(unwords ["hidden service", hn, "available on ports", intercalate "," (map show ports')])
 	(== oniondir)
 	(not . isPrefixOf "HiddenServicePort")
-	(const [oniondir, onionport])
-	(++ [oniondir, onionport])
+	(const (oniondir : onionports))
+	(++ oniondir : onionports)
 	mainConfig
 	`onChange` restarted
   where
 	oniondir = unwords ["HiddenServiceDir", varLib </> hn]
-	onionport = unwords ["HiddenServicePort", show port, "127.0.0.1:" ++ show port]
+	onionports = map onionport ports'
+	ports' = sort ports
+	onionport port = unwords ["HiddenServicePort", show port, "127.0.0.1:" ++ show port]
 
 -- | Same as `hiddenService` but also causes propellor to display
 -- the onion address of the hidden service.
 hiddenServiceAvailable :: HiddenServiceName -> Port -> Property DebianLike
-hiddenServiceAvailable hn port = hiddenServiceHostName $ hiddenService hn port
+hiddenServiceAvailable hn port = hiddenServiceAvailable' hn [port]
+
+hiddenServiceAvailable' :: HiddenServiceName -> [Port] -> Property DebianLike
+hiddenServiceAvailable' hn ports = hiddenServiceHostName $ hiddenService' hn ports
   where
 	hiddenServiceHostName p =  adjustPropertySatisfy p $ \satisfy -> do
 		r <- satisfy
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index 76eae647..0c7e48f2 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -43,7 +43,7 @@ systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go
 		]
 
 -- | Removes user home directory!! Use with caution.
-nuked :: User -> Eep -> Property DebianLike
+nuked :: User -> Eep -> Property Linux
 nuked user@(User u) _ = tightenTargets $ check hashomedir go
 	`describe` ("nuked user " ++ u)
   where
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 6d6b14ea..23066c18 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -24,6 +24,7 @@ module Propellor.Types (
 	, DebianLike
 	, Debian
 	, Buntish
+	, ArchLinux
 	, FreeBSD
 	, HasInfo
 	, type (+)
diff --git a/src/Propellor/Types/CmdLine.hs b/src/Propellor/Types/CmdLine.hs
index 558c6e8b..d712a456 100644
--- a/src/Propellor/Types/CmdLine.hs
+++ b/src/Propellor/Types/CmdLine.hs
@@ -28,4 +28,5 @@ data CmdLine
 	| ChrootChain HostName FilePath Bool Bool
 	| GitPush Fd Fd
 	| Check
+	| Build
 	deriving (Read, Show, Eq)
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
index e064d76f..19d1998e 100644
--- a/src/Propellor/Types/MetaTypes.hs
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -7,6 +7,7 @@ module Propellor.Types.MetaTypes (
 	DebianLike,
 	Debian,
 	Buntish,
+	ArchLinux,
 	FreeBSD,
 	HasInfo,
 	MetaTypes,
@@ -35,14 +36,26 @@ data MetaType
 	deriving (Show, Eq, Ord)
 
 -- | Any unix-like system
-type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ]
+type UnixLike = MetaTypes
+	'[ 'Targeting 'OSDebian
+	, 'Targeting 'OSBuntish
+	, 'Targeting 'OSArchLinux
+	, 'Targeting 'OSFreeBSD
+	]
+
 -- | Any linux system
-type Linux = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
+type Linux = MetaTypes
+	'[ 'Targeting 'OSDebian
+	, 'Targeting 'OSBuntish
+	, 'Targeting 'OSArchLinux
+	]
+
 -- | Debian and derivatives.
 type DebianLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
 type Debian = MetaTypes '[ 'Targeting 'OSDebian ]
 type Buntish = MetaTypes '[ 'Targeting 'OSBuntish ]
 type FreeBSD = MetaTypes '[ 'Targeting 'OSFreeBSD ]
+type ArchLinux = MetaTypes '[ 'Targeting 'OSArchLinux ]
 
 -- | Used to indicate that a Property adds Info to the Host where it's used.
 type HasInfo = MetaTypes '[ 'WithInfo ]
@@ -58,16 +71,19 @@ data instance Sing (x :: MetaType) where
 	OSDebianS :: Sing ('Targeting 'OSDebian)
 	OSBuntishS :: Sing ('Targeting 'OSBuntish)
 	OSFreeBSDS :: Sing ('Targeting 'OSFreeBSD)
+	OSArchLinuxS :: Sing ('Targeting 'OSArchLinux)
 	WithInfoS :: Sing 'WithInfo
 instance SingI ('Targeting 'OSDebian) where sing = OSDebianS
 instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS
 instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS
+instance SingI ('Targeting 'OSArchLinux) where sing = OSArchLinuxS
 instance SingI 'WithInfo where sing = WithInfoS
 instance SingKind ('KProxy :: KProxy MetaType) where
 	type DemoteRep ('KProxy :: KProxy MetaType) = MetaType
 	fromSing OSDebianS = Targeting OSDebian
 	fromSing OSBuntishS = Targeting OSBuntish
 	fromSing OSFreeBSDS = Targeting OSFreeBSD
+	fromSing OSArchLinuxS = Targeting OSArchLinux
 	fromSing WithInfoS = WithInfo
 
 -- | Convenience type operator to combine two `MetaTypes` lists.
@@ -186,6 +202,14 @@ type instance EqT 'OSBuntish 'OSDebian  = 'False
 type instance EqT 'OSBuntish 'OSFreeBSD = 'False
 type instance EqT 'OSFreeBSD 'OSDebian  = 'False
 type instance EqT 'OSFreeBSD 'OSBuntish = 'False
+type instance EqT 'OSArchLinux 'OSArchLinux = 'True
+type instance EqT 'OSArchLinux 'OSDebian    = 'False
+type instance EqT 'OSArchLinux 'OSBuntish   = 'False
+type instance EqT 'OSArchLinux 'OSFreeBSD   = 'False
+type instance EqT 'OSDebian    'OSArchLinux = 'False
+type instance EqT 'OSBuntish   'OSArchLinux = 'False
+type instance EqT 'OSFreeBSD   'OSArchLinux = 'False
+
 -- More modern version if the combinatiorial explosion gets too bad later:
 --
 -- type family Eq (a :: MetaType) (b :: MetaType) where
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index b569a6e8..696c36b0 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -33,6 +33,7 @@ data System = System Distribution Architecture
 data Distribution
 	= Debian DebianKernel DebianSuite
 	| Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>
+	| ArchLinux
 	| FreeBSD FreeBSDRelease
 	deriving (Show, Eq)
 
@@ -41,12 +42,14 @@ data Distribution
 data TargetOS
 	= OSDebian
 	| OSBuntish
+	| OSArchLinux
 	| OSFreeBSD
 	deriving (Show, Eq, Ord)
 
 systemToTargetOS :: System -> TargetOS
 systemToTargetOS (System (Debian _ _) _) = OSDebian
 systemToTargetOS (System (Buntish _) _) = OSBuntish
+systemToTargetOS (System (ArchLinux) _) = OSArchLinux
 systemToTargetOS (System (FreeBSD _) _) = OSFreeBSD
 
 -- | Most of Debian ports are based on Linux. There also exist hurd-i386,
@@ -143,7 +146,7 @@ userGroup :: User -> Group
 userGroup (User u) = Group u
 
 newtype Port = Port Int
-	deriving (Eq, Show)
+	deriving (Eq, Ord, Show)
 
 fromPort :: Port -> String
 fromPort (Port p) = show p