propellor 3.3.1 → 3.4.0

raw patch · 32 files changed

+311/−228 lines, 32 files

Files

• CHANGELOG +17/−0
• debian/changelog +17/−0
• propellor.cabal +2/−1
• src/Propellor/DotDir.hs +2/−2
• src/Propellor/Property/Apache.hs +5/−5
• src/Propellor/Property/Apt.hs +1/−1
• src/Propellor/Property/Apt/PPA.hs +13/−14
• src/Propellor/Property/Attic.hs +5/−5
• src/Propellor/Property/Borg.hs +5/−5
• src/Propellor/Property/Ccache.hs +1/−1
• src/Propellor/Property/Dns.hs +7/−7
• src/Propellor/Property/Docker.hs +3/−3
• src/Propellor/Property/File.hs +6/−0
• src/Propellor/Property/Firewall.hs +38/−39
• src/Propellor/Property/FreeBSD/Poudriere.hs +7/−5
• src/Propellor/Property/Grub.hs +1/−1
• src/Propellor/Property/Logcheck.hs +6/−6
• src/Propellor/Property/Obnam.hs +1/−1
• src/Propellor/Property/OpenId.hs +1/−1
• src/Propellor/Property/Parted.hs +38/−38
• src/Propellor/Property/Sbuild.hs +14/−14
• src/Propellor/Property/SiteSpecific/JoeySites.hs +3/−23
• src/Propellor/Property/Ssh.hs +4/−4
• src/Propellor/Property/Systemd.hs +1/−1
• src/Propellor/Property/Tor.hs +2/−2
• src/Propellor/Property/Unbound.hs +2/−2
• src/Propellor/Spin.hs +1/−1
• src/Propellor/Types.hs +2/−0
• src/Propellor/Types/ConfigurableValue.hs +44/−0
• src/Propellor/Types/Dns.hs +5/−4
• src/Propellor/Types/OS.hs +16/−6
• src/Propellor/Types/ZFS.hs +41/−36

@@ -1,3 +1,20 @@+propellor (3.4.0) unstable; urgency=medium++  * Added ConfigurableValue type class, for values that can be used in a+    config file, or to otherwise configure a program.+  * The val function converts such values to String.+  * Removed fromPort and fromIPAddr (use val instead). (API change)+  * Removed several Show instances that were only used for generating+    configuration, replacing with ConfigurableValue instances. (API change)+  * The github mirror of propellor's git repository has been removed,+    since github's terms of service has started imposing unwanted licensing+    requirements.+  * propellor --init: The option to clone propellor's git repository+    used to use the github mirror, and has been changed to use a different+    mirror.++ -- Joey Hess <id@joeyh.name>  Wed, 01 Mar 2017 16:44:20 -0400+ propellor (3.3.1) unstable; urgency=medium    * Apt: Removed the mirrors.kernel.org line from stdSourcesList etc.

@@ -1,3 +1,20 @@+propellor (3.4.0) unstable; urgency=medium++  * Added ConfigurableValue type class, for values that can be used in a+    config file, or to otherwise configure a program.+  * The val function converts such values to String.+  * Removed fromPort and fromIPAddr (use val instead). (API change)+  * Removed several Show instances that were only used for generating+    configuration, replacing with ConfigurableValue instances. (API change)+  * The github mirror of propellor's git repository has been removed,+    since github's terms of service has started imposing unwanted licensing+    requirements.+  * propellor --init: The option to clone propellor's git repository+    used to use the github mirror, and has been changed to use a different+    mirror.++ -- Joey Hess <id@joeyh.name>  Wed, 01 Mar 2017 16:44:20 -0400+ propellor (3.3.1) unstable; urgency=medium    * Apt: Removed the mirrors.kernel.org line from stdSourcesList etc.

@@ -1,5 +1,5 @@ Name: propellor-Version: 3.3.1+Version: 3.4.0 Cabal-Version: >= 1.8 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -171,6 +171,7 @@     Propellor.EnsureProperty     Propellor.Exception     Propellor.Types+    Propellor.Types.ConfigurableValue     Propellor.Types.Core     Propellor.Types.Chroot     Propellor.Types.CmdLine

@@ -47,10 +47,10 @@ upstreambranch :: String upstreambranch = "upstream/master" --- Using the github mirror of the main propellor repo because+-- Using the joeyh.name mirror of the main propellor repo because -- it is accessible over https for better security. netrepo :: String-netrepo = "https://github.com/joeyh/propellor.git"+netrepo = "https://git.joeyh.name/propellor.git"  dotPropellor :: IO FilePath dotPropellor = do

@@ -72,7 +72,7 @@ listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps 	`onChange` restarted   where-	portline port = "Listen " ++ fromPort port+	portline port = "Listen " ++ val port  -- This is a list of config files because different versions of apache -- use different filenames. Propellor simply writes them all.@@ -135,8 +135,8 @@ -- | Like `virtualHost` but with additional config lines added. virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty DebianLike DebianLike virtualHost' domain port docroot addedcfg = siteEnabled domain $-	[ "<VirtualHost *:" ++ fromPort port ++ ">"-	, "ServerName " ++ domain ++ ":" ++ fromPort port+	[ "<VirtualHost *:" ++ val port ++ ">"+	, "ServerName " ++ domain ++ ":" ++ val port 	, "DocumentRoot " ++ docroot 	, "ErrorLog /var/log/apache2/error.log" 	, "LogLevel warn"@@ -202,8 +202,8 @@ 			] 	sslconffile s = "/etc/apache2/sites-available/ssl/" ++ domain ++ "/" ++ s ++ ".conf" 	vhost p ls =-		[ "<VirtualHost *:" ++ fromPort p ++">"-		, "ServerName " ++ domain ++ ":" ++ fromPort p+		[ "<VirtualHost *:" ++ val p ++">"+		, "ServerName " ++ domain ++ ":" ++ val p 		, "DocumentRoot " ++ docroot 		, "ErrorLog /var/log/apache2/error.log" 		, "LogLevel warn"

@@ -452,7 +452,7 @@ 	[ "Explanation: This file added by propellor" 	, "Package: " ++ p 	, "Pin: release " ++ suitePin suite-	, "Pin-Priority: " ++ show pin+	, "Pin-Priority: " ++ val pin 	]  dpkgStatus :: FilePath

@@ -25,8 +25,8 @@ 	, ppaArchive :: String -- ^ The name of the archive. 	} deriving (Eq, Ord) -instance Show PPA where-	show p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]+instance ConfigurableValue PPA where+	val p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]  instance IsString PPA where 	-- | Parse strings like "ppa:zfs-native/stable" into a PPA.@@ -40,9 +40,9 @@ -- | Adds a PPA to the local system repositories. addPpa :: PPA -> Property DebianLike addPpa p =-	cmdPropertyEnv "apt-add-repository" ["--yes", show p] Apt.noninteractiveEnv+	cmdPropertyEnv "apt-add-repository" ["--yes", val p] Apt.noninteractiveEnv 	`assume` MadeChange-	`describe` ("Added PPA " ++ (show p))+	`describe` ("Added PPA " ++ (val p)) 	`requires` installed  -- | A repository key ID to be downloaded with apt-key.@@ -52,14 +52,11 @@ 	, akiServer :: String 	} deriving (Eq, Ord) -instance Show AptKeyId where-	show k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]- -- | Adds an 'AptKeyId' from the specified GPG server. addKeyId :: AptKeyId -> Property DebianLike addKeyId keyId = 	check keyTrusted akcmd-	`describe` (unwords ["Add third-party Apt key", show keyId])+	`describe` (unwords ["Add third-party Apt key", desc keyId])   where 	akcmd = 		tightenTargets $ cmdProperty "apt-key" ["adv", "--keyserver", akiServer keyId, "--recv-keys", akiId keyId]@@ -72,10 +69,12 @@ 			nkid = take 8 (akiId keyId) 		in 			(isInfixOf [nkid] . pks) <$> readProcess "apt-key" ["list"]+	desc k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]  -- | An Apt source line that apt-add-repository will just add to--- sources.list. It's also an instance of both 'Show' and 'IsString' to make--- using 'OverloadedStrings' in the configuration file easier.+-- sources.list. It's also an instance of both 'ConfigurableValue'+-- and 'IsString' to make using 'OverloadedStrings' in the configuration+-- file easier. -- -- | FIXME there's apparently an optional "options" fragment that I've -- definitely not parsed here.@@ -85,8 +84,8 @@ 	, asComponents :: [String] -- ^ The list of components to install from this repository. 	} deriving (Eq, Ord) -instance Show AptSource where-	show asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]+instance ConfigurableValue AptSource where+	val asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]  instance IsString AptSource where 	fromString s =@@ -103,7 +102,7 @@ addRepository (AptRepositoryPPA p) = addPpa p addRepository (AptRepositorySource src) = 	check repoExists addSrc-	`describe` unwords ["Adding APT repository", show src]+	`describe` unwords ["Adding APT repository", val src] 	`requires` installed   where 	allSourceLines =@@ -112,4 +111,4 @@ 		. filter (not . isPrefixOf "#") 		. filter (/= "") . lines <$> allSourceLines 	repoExists = isInfixOf [src] <$> activeSources-	addSrc = cmdProperty "apt-add-source" [show src]+	addSrc = cmdProperty "apt-add-source" [val src]

@@ -131,11 +131,11 @@ -- passed to the `backup` property, they will run attic prune to clean out -- generations not specified here. keepParam :: KeepPolicy -> AtticParam-keepParam (KeepHours n) = "--keep-hourly=" ++ show n-keepParam (KeepDays n) = "--keep-daily=" ++ show n-keepParam (KeepWeeks n) = "--keep-daily=" ++ show n-keepParam (KeepMonths n) = "--keep-monthly=" ++ show n-keepParam (KeepYears n) = "--keep-yearly=" ++ show n+keepParam (KeepHours n) = "--keep-hourly=" ++ val n+keepParam (KeepDays n) = "--keep-daily=" ++ val n+keepParam (KeepWeeks n) = "--keep-daily=" ++ val n+keepParam (KeepMonths n) = "--keep-monthly=" ++ val n+keepParam (KeepYears n) = "--keep-yearly=" ++ val n  -- | Policy for backup generations to keep. For example, KeepDays 30 will -- keep the latest backup for each day when a backup was made, and keep the

@@ -137,11 +137,11 @@ -- passed to the `backup` property, they will run borg prune to clean out -- generations not specified here. keepParam :: KeepPolicy -> BorgParam-keepParam (KeepHours n) = "--keep-hourly=" ++ show n-keepParam (KeepDays n) = "--keep-daily=" ++ show n-keepParam (KeepWeeks n) = "--keep-daily=" ++ show n-keepParam (KeepMonths n) = "--keep-monthly=" ++ show n-keepParam (KeepYears n) = "--keep-yearly=" ++ show n+keepParam (KeepHours n) = "--keep-hourly=" ++ val n+keepParam (KeepDays n) = "--keep-daily=" ++ val n+keepParam (KeepWeeks n) = "--keep-daily=" ++ val n+keepParam (KeepMonths n) = "--keep-monthly=" ++ val n+keepParam (KeepYears n) = "--keep-yearly=" ++ val n  -- | Policy for backup generations to keep. For example, KeepDays 30 will -- keep the latest backup for each day when a backup was made, and keep the

@@ -76,7 +76,7 @@ limitToParams (MaxSize s) = case maxSizeParam s of 	Just param -> [Right param] 	Nothing -> [Left $ "unable to parse data size " ++ s]-limitToParams (MaxFiles f) = [Right $ "--max-files=" ++ show f]+limitToParams (MaxFiles f) = [Right $ "--max-files=" ++ val f] limitToParams (l1 :+ l2) = limitToParams l1 <> limitToParams l2  -- | Configures a ccache in /var/cache for a group

@@ -250,7 +250,7 @@ 	cfgline f v = "\t" ++ f ++ " " ++ v ++ ";" 	ipblock name l = 		[ "\t" ++ name ++ " {" ] ++-		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) +++		(map (\ip -> "\t\t" ++ val ip ++ ";") l) ++ 		[ "\t};" ] 	mastersblock 		| null (confMasters c) = []@@ -307,17 +307,17 @@ rValue (Address (IPv4 addr)) = Just addr rValue (Address (IPv6 addr)) = Just addr rValue (CNAME d) = Just $ dValue d-rValue (MX pri d) = Just $ show pri ++ " " ++ dValue d+rValue (MX pri d) = Just $ val pri ++ " " ++ dValue d rValue (NS d) = Just $ dValue d rValue (SRV priority weight port target) = Just $ unwords-	[ show priority-	, show weight-	, show port+	[ val priority+	, val weight+	, val port 	, dValue target 	] rValue (SSHFP x y s) = Just $ unwords-	[ show x-	, show y+	[ val x+	, val y 	, s 	] rValue (INCLUDE f) = Just f

@@ -323,7 +323,7 @@ 	toPublish :: p -> String  instance Publishable (Bound Port) where-	toPublish p = fromPort (hostSide p) ++ ":" ++ fromPort (containerSide p)+	toPublish p = val (hostSide p) ++ ":" ++ val (containerSide p)  -- | string format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort instance Publishable String where@@ -660,10 +660,10 @@ listImages = map ImageUID . lines <$> readProcess dockercmd ["images", "--all", "--quiet"]  runProp :: String -> RunParam -> Property (HasInfo + Linux)-runProp field val = tightenTargets $ pureInfoProperty (param) $+runProp field v = tightenTargets $ pureInfoProperty (param) $ 	mempty { _dockerRunParams = [DockerRunParam (\_ -> "--"++param)] }   where-	param = field++"="++val+	param = field++"="++v  genProp :: String -> (HostName -> RunParam) -> Property (HasInfo + Linux) genProp field mkval = tightenTargets $ pureInfoProperty field $

@@ -20,6 +20,12 @@ 	(\_oldcontent -> newcontent) f  -- | Ensures that a line is present in a file, adding it to the end if not.+--+-- For example:+--+-- >	& "/etc/default/daemon.conf" `File.containsLine` ("cachesize = " ++ val 1024)+--+-- The above example uses `val` to serialize a `ConfigurableValue` containsLine :: FilePath -> Line -> Property UnixLike f `containsLine` l = f `containsLines` [l] 

@@ -15,7 +15,6 @@ 	TCPFlag(..), 	Frequency(..), 	IPWithMask(..),-	fromIPWithMask ) where  import Data.Monoid@@ -44,16 +43,16 @@  toIpTable :: Rule -> [CommandParam] toIpTable r =  map Param $-	fromChain (ruleChain r) :+	val (ruleChain r) : 	toIpTableArg (ruleRules r) ++-	["-t", fromTable (ruleTable r), "-j", fromTarget (ruleTarget r)]+	["-t", val (ruleTable r), "-j", val (ruleTarget r)]  toIpTableArg :: Rules -> [String] toIpTableArg Everything = [] toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]-toIpTableArg (DPort port) = ["--dport", fromPort port]+toIpTableArg (DPort port) = ["--dport", val port] toIpTableArg (DPortRange (portf, portt)) =-	["--dport", fromPort portf ++ ":" ++ fromPort portt]+	["--dport", val portf ++ ":" ++ val portt] toIpTableArg (InIFace iface) = ["-i", iface] toIpTableArg (OutIFace iface) = ["-o", iface] toIpTableArg (Ctstate states) =@@ -64,12 +63,12 @@ toIpTableArg (ICMPType i) = 	[ "-m" 	, "icmp"-	, "--icmp-type", fromICMPTypeMatch i+	, "--icmp-type", val i 	] toIpTableArg (RateLimit f) = 	[ "-m" 	, "limit"-	, "--limit", fromFrequency f+	, "--limit", val f 	] toIpTableArg (TCPFlags m c) = 	[ "-m"@@ -87,30 +86,30 @@ 	] toIpTableArg (Source ipwm) = 	[ "-s"-	, intercalate "," (map fromIPWithMask ipwm)+	, intercalate "," (map val ipwm) 	] toIpTableArg (Destination ipwm) = 	[ "-d"-	, intercalate "," (map fromIPWithMask ipwm)+	, intercalate "," (map val ipwm) 	] toIpTableArg (NotDestination ipwm) = 	[ "!" 	, "-d"-	, intercalate "," (map fromIPWithMask ipwm)+	, intercalate "," (map val ipwm) 	] toIpTableArg (NatDestination ip mport) = 	[ "--to-destination"-	, fromIPAddr ip ++ maybe "" (\p -> ":" ++ fromPort p) mport+	, val ip ++ maybe "" (\p -> ":" ++ val p) mport 	] toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'  data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int 	deriving (Eq, Show) -fromIPWithMask :: IPWithMask -> String-fromIPWithMask (IPWithNoMask ip) = fromIPAddr ip-fromIPWithMask (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm-fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m+instance ConfigurableValue IPWithMask where+	val (IPWithNoMask ip) = val ip+	val (IPWithIPMask ip ipm) = val ip ++ "/" ++ val ipm+	val (IPWithNumMask ip m) = val ip ++ "/" ++ val m  data Rule = Rule 	{ ruleChain  :: Chain@@ -122,33 +121,33 @@ data Table = Filter | Nat | Mangle | Raw | Security 	deriving (Eq, Show) -fromTable :: Table -> String-fromTable Filter = "filter"-fromTable Nat = "nat"-fromTable Mangle = "mangle"-fromTable Raw = "raw"-fromTable Security = "security"+instance ConfigurableValue Table where+	val Filter = "filter"+	val Nat = "nat"+	val Mangle = "mangle"+	val Raw = "raw"+	val Security = "security"  data Target = ACCEPT | REJECT | DROP | LOG | TargetCustom String 	deriving (Eq, Show) -fromTarget :: Target -> String-fromTarget ACCEPT = "ACCEPT"-fromTarget REJECT = "REJECT"-fromTarget DROP = "DROP"-fromTarget LOG = "LOG"-fromTarget (TargetCustom t) = t+instance ConfigurableValue Target where+	val ACCEPT = "ACCEPT"+	val REJECT = "REJECT"+	val DROP = "DROP"+	val LOG = "LOG"+	val (TargetCustom t) = t  data Chain = INPUT | OUTPUT | FORWARD | PREROUTING | POSTROUTING | ChainCustom String 	deriving (Eq, Show) -fromChain :: Chain -> String-fromChain INPUT = "INPUT"-fromChain OUTPUT = "OUTPUT"-fromChain FORWARD = "FORWARD"-fromChain PREROUTING = "PREROUTING"-fromChain POSTROUTING = "POSTROUTING"-fromChain (ChainCustom c) = c+instance ConfigurableValue Chain where+	val INPUT = "INPUT"+	val OUTPUT = "OUTPUT"+	val FORWARD = "FORWARD"+	val PREROUTING = "PREROUTING"+	val POSTROUTING = "POSTROUTING"+	val (ChainCustom c) = c  data Proto = TCP | UDP | ICMP 	deriving (Eq, Show)@@ -159,15 +158,15 @@ data ICMPTypeMatch = ICMPTypeName String | ICMPTypeCode Int 	deriving (Eq, Show) -fromICMPTypeMatch :: ICMPTypeMatch -> String-fromICMPTypeMatch (ICMPTypeName t) = t-fromICMPTypeMatch (ICMPTypeCode c) = show c+instance ConfigurableValue ICMPTypeMatch where+	val (ICMPTypeName t) = t+	val (ICMPTypeCode c) = val c  data Frequency = NumBySecond Int 	deriving (Eq, Show) -fromFrequency :: Frequency -> String-fromFrequency (NumBySecond n) = show n ++ "/second"+instance ConfigurableValue Frequency where+	val (NumBySecond n) = val n ++ "/second"  type TCPFlagMask = [TCPFlag] 

@@ -19,6 +19,7 @@  newtype PoudriereConfigured = PoudriereConfigured String 	deriving (Typeable, Monoid, Show)+ instance IsInfo PoudriereConfigured where 	propagateInfo _ = False @@ -68,7 +69,7 @@ 			nx <- liftIO $ not <$> jailExists j 			return $ c && nx -		(cmd, args) = poudriereCommand "jail"  ["-c", "-j", name, "-a", show arch, "-v", show version]+		(cmd, args) = poudriereCommand "jail"  ["-c", "-j", name, "-a", val arch, "-v", val version] 		createJail = cmdProperty cmd args 	in 		check chk createJail@@ -101,10 +102,11 @@ data Jail = Jail String FBSDVersion PoudriereArch  data PoudriereArch = I386 | AMD64 deriving (Eq)-instance Show PoudriereArch where-	show I386 = "i386"-	show AMD64 = "amd64" +instance ConfigurableValue PoudriereArch where+	val I386 = "i386"+	val AMD64 = "amd64"+ fromArchitecture :: Architecture -> PoudriereArch fromArchitecture X86_64 = AMD64 fromArchitecture X86_32 = I386@@ -127,7 +129,7 @@ 	toAssoc (PoudriereZFS (ZFS.ZFS (ZFS.ZPool pool) dataset) _) = 		[ ("NO_ZFS", "no") 		, ("ZPOOL", pool)-		, ("ZROOTFS", show dataset)+		, ("ZROOTFS", val dataset) 		]  type ConfigLine = String

@@ -69,7 +69,7 @@ 	& File.dirExists "/boot/grub" 	& "/boot/grub/menu.lst" `File.hasContent` 		[ "default 1" -		, "timeout " ++ show timeout+		, "timeout " ++ val timeout 		, "" 		, "title grub-xen shim" 		, "root (" ++ rootdev ++ ")"

@@ -16,21 +16,21 @@ data ReportLevel = Workstation | Server | Paranoid type Service = String -instance Show ReportLevel where-	show Workstation = "workstation"-	show Server = "server"-	show Paranoid = "paranoid"+instance ConfigurableValue ReportLevel where+	val Workstation = "workstation"+	val Server = "server"+	val Paranoid = "paranoid"  -- The common prefix used by default in syslog lines. defaultPrefix :: String defaultPrefix = "^\\w{3} [ :[:digit:]]{11} [._[:alnum:]-]+ "  ignoreFilePath :: ReportLevel -> Service -> FilePath-ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (show t) </> n+ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (val t) </> n  ignoreLines :: ReportLevel -> Service -> [String] -> Property UnixLike ignoreLines t n ls = (ignoreFilePath t n) `File.containsLines` ls-	`describe` ("logcheck ignore lines for " ++ n ++ "(" ++ (show t) ++ ")")+	`describe` ("logcheck ignore lines for " ++ n ++ "(" ++ val t ++ ")")  installed :: Property DebianLike installed = Apt.installed ["logcheck"]

@@ -150,7 +150,7 @@ 	go (KeepWeeks n) = mk n 'w' 	go (KeepMonths n) = mk n 'm' 	go (KeepYears n) = mk n 'y'-	mk n c = show n ++ [c]+	mk n c = val n ++ [c]  isKeepParam :: ObnamParam -> Bool isKeepParam p = "--keep=" `isPrefixOf` p

@@ -28,7 +28,7 @@   where 	baseurl = hn ++ case mp of 		Nothing -> ""-		Just p -> ':' : fromPort p+		Just p -> ':' : val p 	url = "http://"++baseurl++"/simpleid" 	desc = "openid provider " ++ url 	setbaseurl l

@@ -30,14 +30,14 @@ import System.Posix.Files  class PartedVal a where-	val :: a -> String+	pval :: a -> String  -- | Types of partition tables supported by parted. data TableType = MSDOS | GPT | AIX | AMIGA | BSD | DVH | LOOP | MAC | PC98 | SUN 	deriving (Show)  instance PartedVal TableType where-	val = map toLower . show+	pval = map toLower . show  -- | A disk's partition table. data PartTable = PartTable TableType [Partition]@@ -82,9 +82,9 @@ 	deriving (Show)  instance PartedVal PartType where-	val Primary = "primary"-	val Logical = "logical"-	val Extended = "extended"+	pval Primary = "primary"+	pval Logical = "logical"+	pval Extended = "extended"  -- | All partition sizing is done in megabytes, so that parted can -- automatically lay out the partitions.@@ -94,11 +94,11 @@ 	deriving (Show)  instance PartedVal PartSize where-	val (MegaBytes n)-		| n > 0 = show n ++ "MB"+	pval (MegaBytes n)+		| n > 0 = val n ++ "MB" 		-- parted can't make partitions smaller than 1MB; 		-- avoid failure in edge cases-		| otherwise = show "1MB"+		| otherwise = "1MB"  -- | Rounds up to the nearest MegaByte. toPartSize :: ByteSize -> PartSize@@ -119,33 +119,33 @@ 	deriving (Show)  instance PartedVal PartFlag where-	val BootFlag = "boot"-	val RootFlag = "root"-	val SwapFlag = "swap"-	val HiddenFlag = "hidden"-	val RaidFlag = "raid"-	val LvmFlag = "lvm"-	val LbaFlag = "lba"-	val LegacyBootFlag = "legacy_boot"-	val IrstFlag = "irst"-	val EspFlag = "esp"-	val PaloFlag = "palo"+	pval BootFlag = "boot"+	pval RootFlag = "root"+	pval SwapFlag = "swap"+	pval HiddenFlag = "hidden"+	pval RaidFlag = "raid"+	pval LvmFlag = "lvm"+	pval LbaFlag = "lba"+	pval LegacyBootFlag = "legacy_boot"+	pval IrstFlag = "irst"+	pval EspFlag = "esp"+	pval PaloFlag = "palo"  instance PartedVal Bool where-	val True = "on"-	val False = "off"+	pval True = "on"+	pval False = "off"  instance PartedVal Partition.Fs where-	val Partition.EXT2 = "ext2"-	val Partition.EXT3 = "ext3"-	val Partition.EXT4 = "ext4"-	val Partition.BTRFS = "btrfs"-	val Partition.REISERFS = "reiserfs"-	val Partition.XFS = "xfs"-	val Partition.FAT = "fat"-	val Partition.VFAT = "vfat"-	val Partition.NTFS = "ntfs"-	val Partition.LinuxSwap = "linux-swap"+	pval Partition.EXT2 = "ext2"+	pval Partition.EXT3 = "ext3"+	pval Partition.EXT4 = "ext4"+	pval Partition.BTRFS = "btrfs"+	pval Partition.REISERFS = "reiserfs"+	pval Partition.XFS = "xfs"+	pval Partition.FAT = "fat"+	pval Partition.VFAT = "vfat"+	pval Partition.NTFS = "ntfs"+	pval Partition.LinuxSwap = "linux-swap"  data Eep = YesReallyDeleteDiskContents @@ -168,19 +168,19 @@ 	partedparams = concat $ mklabel : mkparts (1 :: Integer) mempty parts [] 	format (p, dev) = Partition.formatted' (partMkFsOpts p) 		Partition.YesReallyFormatPartition (partFs p) dev-	mklabel = ["mklabel", val tabletype]+	mklabel = ["mklabel", pval tabletype] 	mkflag partnum (f, b) = 		[ "set" 		, show partnum-		, val f-		, val b+		, pval f+		, pval b 		] 	mkpart partnum offset p = 		[ "mkpart"-		, val (partType p)-		, val (partFs p)-		, val offset-		, val (offset <> partSize p)+		, pval (partType p)+		, pval (partFs p)+		, pval offset+		, pval (offset <> partSize p) 		] ++ case partName p of 			Just n -> ["name", show partnum, n] 			Nothing -> []

@@ -111,8 +111,8 @@ -- the same suite and the same architecture, so neither do we data SbuildSchroot = SbuildSchroot Suite Architecture -instance Show SbuildSchroot where-	show (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch+instance ConfigurableValue SbuildSchroot where+	val (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch  -- | Whether an sbuild schroot should use ccache during builds --@@ -151,7 +151,7 @@   where 	go :: Property DebianLike 	go = check (unpopulated (schrootRoot s) <||> ispartial) $-		property' ("built sbuild schroot for " ++ show s) make+		property' ("built sbuild schroot for " ++ val s) make 	make w = do 		de <- liftIO standardPathEnv 		let params = Param <$>@@ -170,18 +170,18 @@ 	-- TODO we should kill any sessions still using the chroot 	-- before destroying it (as suggested by sbuild-destroychroot) 	deleted = check (not <$> unpopulated (schrootRoot s)) $-		property ("no sbuild schroot for " ++ show s) $ do+		property ("no sbuild schroot for " ++ val s) $ do 			liftIO $ removeChroot $ schrootRoot s 			liftIO $ nukeFile-				("/etc/sbuild/chroot" </> show s ++ "-sbuild")+				("/etc/sbuild/chroot" </> val s ++ "-sbuild") 			makeChange $ nukeFile (schrootConf s)  	enhancedConf =-		combineProperties ("enhanced schroot conf for " ++ show s) $ props+		combineProperties ("enhanced schroot conf for " ++ val s) $ props 			& aliasesLine 			-- enable ccache and eatmydata for speed 			& ConfFile.containsIniSetting (schrootConf s)-				( show s ++ "-sbuild"+				( val s ++ "-sbuild" 				, "command-prefix" 				, intercalate "," commandPrefix 				)@@ -196,7 +196,7 @@ 			then ensureProperty w $ 				ConfFile.containsIniSetting 					(schrootConf s)-					( show s ++ "-sbuild"+					( val s ++ "-sbuild" 					, "aliases" 					, aliases 					)@@ -263,7 +263,7 @@ updated :: SbuildSchroot -> Property DebianLike updated s@(SbuildSchroot suite arch) = 	check (doesDirectoryExist (schrootRoot s)) $ go-	`describe` ("updated schroot for " ++ show s)+	`describe` ("updated schroot for " ++ val s) 	`requires` installed   where 	go :: Property DebianLike@@ -283,13 +283,13 @@ -- given suite and architecture, so we don't need the suffix to be random. fixConfFile :: SbuildSchroot -> Property UnixLike fixConfFile s@(SbuildSchroot suite arch) =-	property' ("schroot for " ++ show s ++ " config file fixed") $ \w -> do+	property' ("schroot for " ++ val s ++ " config file fixed") $ \w -> do 		confs <- liftIO $ dirContents dir 		let old = concat $ filter (tempPrefix `isPrefixOf`) confs 		liftIO $ moveFile old new 		liftIO $ moveFile-			("/etc/sbuild/chroot" </> show s ++ "-propellor")-			("/etc/sbuild/chroot" </> show s ++ "-sbuild")+			("/etc/sbuild/chroot" </> val s ++ "-propellor")+			("/etc/sbuild/chroot" </> val s ++ "-sbuild") 		ensureProperty w $ 			File.fileProperty "replace dummy suffix" (map munge) new   where@@ -361,10 +361,10 @@  	orig = "/etc/schroot/sbuild" 	dir = "/etc/schroot/piuparts"-	sec = show s ++ "-piuparts"+	sec = val s ++ "-piuparts" 	f = schrootPiupartsConf s 	munge = replace "-sbuild]" "-piuparts]"-	desc = "piuparts schroot conf for " ++ show s+	desc = "piuparts schroot conf for " ++ val s  	-- normally the piuparts schroot conf has no aliases, but we have to add 	-- one, for dgit compatibility, if this is the default sid chroot

@@ -314,9 +314,9 @@  apachecfg :: HostName -> Apache.ConfigFile -> Apache.ConfigFile apachecfg hn middle =-	[ "<VirtualHost *:"++show port++">"+	[ "<VirtualHost *:" ++ val port ++ ">" 	, "  ServerAdmin grue@joeyh.name"-	, "  ServerName "++hn++":"++show port+	, "  ServerName "++hn++":" ++ val port 	] 	++ middle ++ 	[ ""@@ -329,7 +329,7 @@ 	, "</VirtualHost>" 	] 	  where-		port = 80 :: Int+		port = Port 80  gitAnnexDistributor :: Property (HasInfo + DebianLike) gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer" $ props@@ -405,8 +405,6 @@ 	& githubKeys 	& Cron.niceJob "github-backup run" (Cron.Times "30 4 * * *") (User "joey") 		"/home/joey/lib/backup" backupcmd-	& Cron.niceJob "gitriddance" (Cron.Times "30 4 * * *") (User "joey")-		"/home/joey/lib/backup" gitriddancecmd   where 	backupcmd = intercalate "&&" $ 		[ "mkdir -p github"@@ -414,11 +412,6 @@ 		, ". $HOME/.github-keys" 		, "github-backup joeyh" 		]-	gitriddancecmd = intercalate "&&" $-		[ "cd github"-		, ". $HOME/.github-keys"-		] ++ map gitriddance githubMirrors-	gitriddance (r, msg) = "(cd " ++ r ++ " && gitriddance " ++ shellEscape msg ++ ")"  githubKeys :: Property (HasInfo + UnixLike) githubKeys =@@ -426,19 +419,6 @@ 	in File.hasPrivContent f anyContext 		`onChange` File.ownerGroup f (User "joey") (Group "joey") ---- these repos are only mirrored on github, I don't want--- all the proprietary features-githubMirrors :: [(String, String)]-githubMirrors =-	[ ("ikiwiki", plzuseurl "http://ikiwiki.info/todo/")-	, ("git-annex", plzuseurl "http://git-annex.branchable.com/todo/")-	, ("myrepos", plzuseurl "http://myrepos.branchable.com/todo/")-	, ("propellor", plzuseurl "http://propellor.branchable.com/todo/")-	, ("etckeeper", plzuseurl "http://etckeeper.branchable.com/todo/")-	]-  where-	plzuseurl u = "Please submit changes to " ++ u ++ " instead of using github pull requests, which are not part of my workflow. Just open a todo item there and link to a git repository containing your changes. Did you know, git is a distributed system? The git repository doesn't even need to be on github! Please send any complaints to Github; they don't allow turning off pull requests or redirecting them elsewhere.  -- A robot acting on behalf of Joey Hess"  rsyncNetBackup :: [Host] -> Property DebianLike rsyncNetBackup hosts = Cron.niceJob "rsync.net copied in daily" (Cron.Times "30 5 * * *")

@@ -69,11 +69,11 @@ setSshdConfigBool setting allowed = setSshdConfig setting (sshBool allowed)  setSshdConfig :: ConfigKeyword -> String -> Property DebianLike-setSshdConfig setting val = File.fileProperty desc f sshdConfig+setSshdConfig setting v = File.fileProperty desc f sshdConfig 	`onChange` restarted   where-	desc = unwords [ "ssh config:", setting, val ]-	cfgline = setting ++ " " ++ val+	desc = unwords [ "ssh config:", setting, v ]+	cfgline = setting ++ " " ++ v 	wantedline s 		| s == cfgline = True 		| (setting ++ " ") `isPrefixOf` s = False@@ -120,7 +120,7 @@ listenPort :: Port -> RevertableProperty DebianLike DebianLike listenPort port = enable <!> disable   where-	portline = "Port " ++ fromPort port+	portline = "Port " ++ val port 	enable = sshdConfig `File.containsLine` portline 		`describe` ("ssh listening on " ++ portline) 		`onChange` restarted

@@ -421,7 +421,7 @@ 	toPublish :: a -> String  instance Publishable Port where-	toPublish port = fromPort port+	toPublish port = val port  instance Publishable (Bound Port) where 	toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v)

@@ -128,7 +128,7 @@  hiddenService' :: HiddenServiceName -> [Port] -> Property DebianLike hiddenService' hn ports = ConfFile.adjustSection-	(unwords ["hidden service", hn, "available on ports", intercalate "," (map fromPort ports')])+	(unwords ["hidden service", hn, "available on ports", intercalate "," (map val ports')]) 	(== oniondir) 	(not . isPrefixOf "HiddenServicePort") 	(const (oniondir : onionports))@@ -139,7 +139,7 @@ 	oniondir = unwords ["HiddenServiceDir", varLib </> hn] 	onionports = map onionport ports' 	ports' = sort ports-	onionport port = unwords ["HiddenServicePort", fromPort port, "127.0.0.1:" ++ fromPort port]+	onionport port = unwords ["HiddenServicePort", val port, "127.0.0.1:" ++ val port]  -- | Same as `hiddenService` but also causes propellor to display -- the onion address of the hidden service.

@@ -133,10 +133,10 @@ 	IPv6 _ -> genAddress' "AAAA" dom ttl addr  genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String-genAddress' recordtype dom ttl addr = dValue dom ++ " " ++ maybe "" (\ttl' -> show ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr+genAddress' recordtype dom ttl addr = dValue dom ++ " " ++ maybe "" (\ttl' -> val ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ val addr  genMX :: BindDomain -> Int -> BindDomain -> String-genMX dom priority dest = dValue dom ++ " " ++ "MX" ++ " " ++ show priority ++ " " ++ dValue dest+genMX dom priority dest = dValue dom ++ " " ++ "MX" ++ " " ++ val priority ++ " " ++ dValue dest  genPTR :: BindDomain -> ReverseIP -> String genPTR dom revip = revip ++ ". " ++ "PTR" ++ " " ++ dValue dom

@@ -169,7 +169,7 @@ 					warningMessage $ "DNS seems out of date for " ++ target ++ " (" ++ why ++ "); using IP address from configuration instead." 					return ip -	configips = map fromIPAddr $ mapMaybe getIPAddr $+	configips = map val $ mapMaybe getIPAddr $ 		S.toList $ fromDnsInfo $ fromInfo $ hostInfo hst  -- Update the privdata, repo url, and git repo over the ssh

@@ -36,6 +36,7 @@ 	, adjustPropertySatisfy 	-- * Other included types 	, module Propellor.Types.OS+	, module Propellor.Types.ConfigurableValue 	, module Propellor.Types.Dns 	, module Propellor.Types.Result 	, module Propellor.Types.ZFS@@ -46,6 +47,7 @@ import Propellor.Types.Core import Propellor.Types.Info import Propellor.Types.OS+import Propellor.Types.ConfigurableValue import Propellor.Types.Dns import Propellor.Types.Result import Propellor.Types.MetaTypes

@@ -0,0 +1,44 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++module Propellor.Types.ConfigurableValue where++import Data.Word++-- | A value that can be used in a configuration file, or otherwise used to+-- configure a program.+--+-- Unlike Show, there should only be instances of this type class for+-- values that have a standard serialization that is understood outside of+-- Haskell code.+--+-- When converting a type alias such as "type Foo = String" or "type Foo = Int"+-- to a newtype, it's unsafe to derive a Show instance, because there may+-- be code that shows the type to configure a value. Instead, define a+-- ConfigurableValue instance.+class ConfigurableValue t where+	val :: t -> String++-- | val String does not do any quoting, unlike show String+instance ConfigurableValue String where+	val = id++instance ConfigurableValue Int where+	val = show++instance ConfigurableValue Integer where+	val = show++instance ConfigurableValue Float where+	val = show++instance ConfigurableValue Double where+	val = show++instance ConfigurableValue Word8 where+	val = show++instance ConfigurableValue Word16 where+	val = show++instance ConfigurableValue Word32 where+	val = show

@@ -5,6 +5,7 @@ import Propellor.Types.OS (HostName) import Propellor.Types.Empty import Propellor.Types.Info+import Propellor.Types.ConfigurableValue  import Data.Word import qualified Data.Map as M@@ -19,9 +20,9 @@ data IPAddr = IPv4 String | IPv6 String 	deriving (Read, Show, Eq, Ord) -fromIPAddr :: IPAddr -> String-fromIPAddr (IPv4 addr) = addr-fromIPAddr (IPv6 addr) = addr+instance ConfigurableValue IPAddr where+	val (IPv4 addr) = addr+	val (IPv6 addr) = addr  newtype AliasesInfo = AliasesInfo (S.Set HostName) 	deriving (Show, Eq, Ord, Monoid, Typeable)@@ -102,7 +103,7 @@  reverseIP :: IPAddr -> ReverseIP reverseIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa"-reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonicalIP addr) ++ ".ip6.arpa"+reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ val $ canonicalIP addr) ++ ".ip6.arpa"  -- | Converts an IP address (particularly IPv6) to canonical, fully -- expanded form.

@@ -18,10 +18,11 @@ 	Group(..), 	userGroup, 	Port(..),-	fromPort, 	systemToTargetOS, ) where +import Propellor.Types.ConfigurableValue+ import Network.BSD (HostName) import Data.Typeable import Data.String@@ -75,10 +76,13 @@ 	fromString "9.3-RELEASE" = FBSD093 	fromString _ = error "Invalid FreeBSD release" +instance ConfigurableValue FBSDVersion where+	val FBSD101 = "10.1-RELEASE"+	val FBSD102 = "10.2-RELEASE"+	val FBSD093 = "9.3-RELEASE"+ instance Show FBSDVersion where-	show FBSD101 = "10.1-RELEASE"-	show FBSD102 = "10.2-RELEASE"-	show FBSD093 = "9.3-RELEASE"+	show = val  isStable :: DebianSuite -> Bool isStable (Stable _) = True@@ -138,9 +142,15 @@ newtype User = User UserName 	deriving (Eq, Ord, Show) +instance ConfigurableValue User where+	val (User n) = n+ newtype Group = Group String 	deriving (Eq, Ord, Show) +instance ConfigurableValue Group where+	val (Group n) = n+ -- | Makes a Group with the same name as the User. userGroup :: User -> Group userGroup (User u) = Group u@@ -148,5 +158,5 @@ newtype Port = Port Int 	deriving (Eq, Ord, Show) -fromPort :: Port -> String-fromPort (Port p) = show p+instance ConfigurableValue Port where+	val (Port p) = show p

@@ -6,6 +6,8 @@  module Propellor.Types.ZFS where +import Propellor.Types.ConfigurableValue+ import Data.String import qualified Data.Set as Set import qualified Data.String.Utils as SU@@ -32,24 +34,27 @@  fromPropertyList :: [(String, String)] -> ZFSProperties fromPropertyList props =-  Set.fromList $ map fromPair props+	Set.fromList $ map fromPair props  zfsName :: ZFS -> String zfsName (ZFS (ZPool pool) dataset) = intercalate "/" [pool, show dataset] +instance ConfigurableValue ZDataset where+	val (ZDataset paths) = intercalate "/" paths+ instance Show ZDataset where-  show (ZDataset paths) = intercalate "/" paths+	show = val  instance IsString ZDataset where-  fromString s = ZDataset $ SU.split "/" s+	fromString s = ZDataset $ SU.split "/" s  instance IsString ZPool where-  fromString p = ZPool p+	fromString p = ZPool p  class Value a where-  toValue :: a -> String-  fromValue :: (IsString a) => String -> a-  fromValue = fromString+	toValue :: a -> String+	fromValue :: (IsString a) => String -> a+	fromValue = fromString  data ZFSYesNo = ZFSYesNo Bool deriving (Show, Eq, Ord) data ZFSOnOff = ZFSOnOff Bool deriving (Show, Eq, Ord)@@ -57,57 +62,57 @@ data ZFSString = ZFSString String deriving (Show, Eq, Ord)  instance Value ZFSYesNo where-  toValue (ZFSYesNo True) = "yes"-  toValue (ZFSYesNo False) = "no"+	toValue (ZFSYesNo True) = "yes"+	toValue (ZFSYesNo False) = "no"  instance Value ZFSOnOff where-  toValue (ZFSOnOff True) = "on"-  toValue (ZFSOnOff False) = "off"+	toValue (ZFSOnOff True) = "on"+	toValue (ZFSOnOff False) = "off"  instance Value ZFSSize where-  toValue (ZFSSize s) = show s+	toValue (ZFSSize s) = show s  instance Value ZFSString where-  toValue (ZFSString s) = s+	toValue (ZFSString s) = s  instance IsString ZFSString where-  fromString = ZFSString+	fromString = ZFSString  instance IsString ZFSYesNo where-  fromString "yes" = ZFSYesNo True-  fromString "no" = ZFSYesNo False-  fromString _ = error "Not yes or no"+	fromString "yes" = ZFSYesNo True+	fromString "no" = ZFSYesNo False+	fromString _ = error "Not yes or no"  instance IsString ZFSOnOff where-  fromString "on" = ZFSOnOff True-  fromString "off" = ZFSOnOff False-  fromString _ = error "Not on or off"+	fromString "on" = ZFSOnOff True+	fromString "off" = ZFSOnOff False+	fromString _ = error "Not on or off"  data ZFSACLInherit = AIDiscard | AINoAllow | AISecure | AIPassthrough deriving (Show, Eq, Ord) instance IsString ZFSACLInherit where-  fromString "discard" = AIDiscard-  fromString "noallow" = AINoAllow-  fromString "secure" = AISecure-  fromString "passthrough" = AIPassthrough-  fromString _ = error "Not valid aclpassthrough value"+	fromString "discard" = AIDiscard+	fromString "noallow" = AINoAllow+	fromString "secure" = AISecure+	fromString "passthrough" = AIPassthrough+	fromString _ = error "Not valid aclpassthrough value"  instance Value ZFSACLInherit where-  toValue AIDiscard = "discard"-  toValue AINoAllow = "noallow"-  toValue AISecure = "secure"-  toValue AIPassthrough = "passthrough"+	toValue AIDiscard = "discard"+	toValue AINoAllow = "noallow"+	toValue AISecure = "secure"+	toValue AIPassthrough = "passthrough"  data ZFSACLMode = AMDiscard | AMGroupmask | AMPassthrough deriving (Show, Eq, Ord) instance IsString ZFSACLMode where-  fromString "discard" = AMDiscard-  fromString "groupmask" = AMGroupmask-  fromString "passthrough" = AMPassthrough-  fromString _ = error "Invalid zfsaclmode"+	fromString "discard" = AMDiscard+	fromString "groupmask" = AMGroupmask+	fromString "passthrough" = AMPassthrough+	fromString _ = error "Invalid zfsaclmode"  instance Value ZFSACLMode where-  toValue AMDiscard = "discard"-  toValue AMGroupmask = "groupmask"-  toValue AMPassthrough = "passthrough"+	toValue AMDiscard = "discard"+	toValue AMGroupmask = "groupmask"+	toValue AMPassthrough = "passthrough"  data ZFSProperty = Mounted ZFSYesNo 	       | Mountpoint ZFSString