propellor 4.0.1 → 4.0.2

raw patch · 10 files changed

+118/−53 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +15/−0
• debian/changelog +15/−0
• joeyconfig.hs +2/−17
• propellor.cabal +1/−1
• src/Propellor/Property/Apt.hs +50/−14
• src/Propellor/Property/Chroot.hs +9/−7
• src/Propellor/Property/DiskImage.hs +1/−1
• src/Propellor/Property/Partition.hs +20/−4
• src/Propellor/Property/Sbuild.hs +4/−8
• src/Propellor/Property/Systemd.hs +1/−1

@@ -1,3 +1,18 @@+propellor (4.0.2) unstable; urgency=medium++  * Apt.mirror can be used to set the preferred apt mirror of a host,+    overriding the default CDN. This info is used by +    Apt.stdSourcesList and Sbuild.builtFor.+    Thanks, Sean Whitton.+  * Property.Partition: Update kpartx output parser, as its output format+    changed around version 0.6. Both output formats are supported now.+  * Fix bug when using setContainerProps with a chroot that prevented+    properties added to a chroot that way from being seen when propellor+    was running inside the chroot. This affected disk image creation, and+    possibly other things that use chroots.++ -- Joey Hess <id@joeyh.name>  Fri, 24 Mar 2017 14:04:50 -0400+ propellor (4.0.1) unstable; urgency=medium    * Fix build with pre-AMP ghc.

@@ -1,3 +1,18 @@+propellor (4.0.2) unstable; urgency=medium++  * Apt.mirror can be used to set the preferred apt mirror of a host,+    overriding the default CDN. This info is used by +    Apt.stdSourcesList and Sbuild.builtFor.+    Thanks, Sean Whitton.+  * Property.Partition: Update kpartx output parser, as its output format+    changed around version 0.6. Both output formats are supported now.+  * Fix bug when using setContainerProps with a chroot that prevented+    properties added to a chroot that way from being seen when propellor+    was running inside the chroot. This affected disk image creation, and+    possibly other things that use chroots.++ -- Joey Hess <id@joeyh.name>  Fri, 24 Mar 2017 14:04:50 -0400+ propellor (4.0.1) unstable; urgency=medium    * Fix build with pre-AMP ghc.

@@ -126,18 +126,12 @@ 	& Apt.unattendedUpgrades 	& Network.ipv6to4 	& Systemd.persistentJournal-	& Journald.systemMaxUse "500MiB"+	& Journald.systemMaxUse "50MiB"  	& Tor.isRelay 	& Tor.named "kite1" 	& Tor.bandwidthRate (Tor.PerMonth "400 GB") -	& Systemd.nspawned webserver-	& File.dirExists "/var/www/html"-	& File.notPresent "/var/www/index.html"-	& "/var/www/html/index.html" `File.hasContent` ["hello, world"]-	& alias "helloworld.kitenet.net"- 	& Systemd.nspawned oldusenetShellBox  	& JoeySites.scrollBox@@ -174,6 +168,7 @@ 	& Network.ipv6to4 	& Systemd.persistentJournal 	& Journald.systemMaxUse "500MiB"+	& Apt.serviceInstalledRunning "swapspace"  	& Tor.isRelay 	& Tor.named "kite4"@@ -540,13 +535,6 @@ --------------------------- \____, o          ,' ---------------------------- ---------------------------- '--,___________,'  ----------------------------- --- Simple web server, publishing the outside host's /var/www-webserver :: Systemd.Container-webserver = Systemd.debContainer "webserver" $ props-	& standardContainer (Stable "jessie")-	& Systemd.bind "/var/www"-	& Apache.installed- -- My own openid provider. Uses php, so containerized for security -- and administrative sanity. openidProvider :: Systemd.Container@@ -659,9 +647,6 @@ 		& Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY=" 	, host "ns6.gandi.net" $ props 		& ipv4 "217.70.177.40"-	, host "turtle.kitenet.net" $ props-		& ipv4 "67.223.19.96"-		& ipv6 "2001:4978:f:2d9::2" 	, host "mouse.kitenet.net" $ props 		& ipv6 "2001:4830:1600:492::2" 		& ipv4 "67.223.19.96"

@@ -1,5 +1,5 @@ Name: propellor-Version: 4.0.1+Version: 4.0.2 Cabal-Version: >= 1.8 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>

@@ -1,9 +1,11 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}  module Propellor.Property.Apt where  import Data.Maybe import Data.List+import Data.Typeable import System.IO import Control.Monad import Control.Applicative@@ -13,7 +15,38 @@ import qualified Propellor.Property.File as File import qualified Propellor.Property.Service as Service import Propellor.Property.File (Line)+import Propellor.Types.Info +data HostMirror = HostMirror Url+	deriving (Eq, Show, Typeable)++-- | Indicate host's preferred apt mirror (e.g. an apt cacher on the host's LAN)+mirror :: Url -> Property (HasInfo + UnixLike)+mirror u = pureInfoProperty (u ++ " apt mirror selected")+	     (InfoVal (HostMirror u))++getMirror :: Propellor Url+getMirror = do+	mirrorInfo <- getMirrorInfo+	osInfo <- getOS+	return $ case (osInfo, mirrorInfo) of+		(_, Just (HostMirror u)) -> u+		(Just (System (Debian _ _) _), _) ->+			"http://deb.debian.org/debian"+		(Just (System (Buntish _) _), _) ->+			"mirror://mirrors.ubuntu.com/"+		(Just (System dist _), _) ->+			error ("no Apt mirror defined for " ++ show dist)+		_ -> error "no Apt mirror defined for this host or OS"+  where+	getMirrorInfo :: Propellor (Maybe HostMirror)+	getMirrorInfo = fromInfoVal <$> askInfo++withMirror :: Desc -> (Url -> Property DebianLike) -> Property DebianLike+withMirror desc mkp = property' desc $ \w -> do+	u <- getMirror+	ensureProperty w (mkp u)+ sourcesList :: FilePath sourcesList = "/etc/apt/sources.list" @@ -37,8 +70,8 @@ stableUpdatesSuite _ = Nothing  debLine :: String -> Url -> [Section] -> Line-debLine suite mirror sections = unwords $-	["deb", mirror, suite] ++ sections+debLine suite url sections = unwords $+	["deb", url, suite] ++ sections  srcLine :: Line -> Line srcLine l = case words l of@@ -61,8 +94,8 @@ 		bs <- backportSuite suite 		return $ debLine bs url stdSections -debCdn :: SourcesGenerator-debCdn = binandsrc "http://deb.debian.org/debian"+stdArchiveLines :: Propellor SourcesGenerator+stdArchiveLines = return . binandsrc =<< getMirror  -- | Only available for Stable and Testing securityUpdates :: SourcesGenerator@@ -72,8 +105,9 @@ 		in [l, srcLine l] 	| otherwise = [] --- | Makes sources.list have a standard content using the Debian mirror CDN,--- with the Debian suite configured by the os.+-- | Makes sources.list have a standard content using the Debian mirror CDN+-- (or other host specified using the `mirror` property), with the+-- Debian suite configured by the os. stdSourcesList :: Property Debian stdSourcesList = withOS "standard sources.list" $ \w o -> case o of 	(Just (System (Debian _ suite) _)) ->@@ -88,11 +122,12 @@ -- Note that if a Property needs to enable an apt source, it's better -- to do so via a separate file in </etc/apt/sources.list.d/> stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian-stdSourcesList' suite more = tightenTargets $ setSourcesList-	(concatMap (\gen -> gen suite) generators)-	`describe` ("standard sources.list for " ++ show suite)+stdSourcesList' suite more = tightenTargets $+	withMirror desc $ \u -> setSourcesList+		(concatMap (\gen -> gen suite) (generators u))   where-	generators = [debCdn, securityUpdates] ++ more+	generators u = [binandsrc u, securityUpdates] ++ more+	desc = ("standard sources.list for " ++ show suite)  type PinPriority = Int @@ -120,23 +155,24 @@ 		& File.notPresent prefFile  	setSourcesFile :: Property Debian-	setSourcesFile = withOS (desc True) $ \w o -> case o of+	setSourcesFile = tightenTargets $ withMirror (desc True) $ \u ->+		withOS (desc True) $ \w o -> case o of 			(Just (System (Debian _ hostSuite) _)) 				| s /= hostSuite -> ensureProperty w $-					File.hasContent sourcesFile sources+					File.hasContent sourcesFile (sources u) 					`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+	sources u = dropBackports $ concatMap (\gen -> gen s) (generators u) 	  where 		dropBackports 			| "-backports" `isSuffixOf` (showSuite s) = id 			| otherwise = filter (not . isInfixOf "-backports") -	generators = [debCdn, securityUpdates]+	generators u = [binandsrc u, securityUpdates] 	prefFile = "/etc/apt/preferences.d/20" ++ showSuite s ++ ".pref" 	sourcesFile = "/etc/apt/sources.list.d/" ++ showSuite s ++ ".list" 

@@ -46,7 +46,9 @@ instance IsContainer Chroot where 	containerProperties (Chroot _ _ _ h) = containerProperties h 	containerInfo (Chroot _ _ _ h) = containerInfo h-	setContainerProperties (Chroot loc b p h) ps = Chroot loc b p (setContainerProperties h ps)+	setContainerProperties (Chroot loc b p h) ps =+		let h' = setContainerProperties h ps+		in Chroot loc b p h'  chrootSystem :: Chroot -> Maybe System chrootSystem = fromInfoVal . fromInfo . containerInfo@@ -118,7 +120,7 @@ bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot bootstrapped bootstrapper location ps = c   where-	c = Chroot location bootstrapper (propagateChrootInfo c) (host location ps)+	c = Chroot location bootstrapper propagateChrootInfo (host location ps)  -- | Ensures that the chroot exists and is provisioned according to its -- properties.@@ -134,7 +136,7 @@ 	-> Bool 	-> RevertableProperty (HasInfo + Linux) Linux provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly =-	(infopropigator normalContainerInfo $ setup `describe` chrootDesc c "exists")+	(infopropigator c normalContainerInfo $ setup `describe` chrootDesc c "exists") 		<!> 	(teardown `describe` chrootDesc c "removed")   where@@ -153,9 +155,9 @@ 		property ("removed " ++ loc) $ 			makeChange (removeChroot loc) -type InfoPropagator = (PropagateInfo -> Bool) -> Property Linux -> Property (HasInfo + Linux)+type InfoPropagator = Chroot -> (PropagateInfo -> Bool) -> Property Linux -> Property (HasInfo + Linux) -propagateChrootInfo :: Chroot -> InfoPropagator+propagateChrootInfo :: InfoPropagator propagateChrootInfo c@(Chroot location _ _ _) pinfo p = 	propagateContainer location c pinfo $ 		p `setInfoProperty` chrootInfo c@@ -302,12 +304,12 @@ hostChroot h bootstrapper d = chroot   where 	chroot = Chroot d bootstrapper pinfo h-	pinfo = propagateHostChrootInfo h chroot+	pinfo = propagateHostChrootInfo h  -- This is different than propagateChrootInfo in that Info using -- HostContext is not made to use the name of the chroot as its context, -- but instead uses the hostname of the Host.-propagateHostChrootInfo :: Host -> Chroot -> InfoPropagator+propagateHostChrootInfo :: Host -> InfoPropagator propagateHostChrootInfo h c pinfo p = 	propagateContainer (hostName h) c pinfo $ 		p `setInfoProperty` chrootInfo c

@@ -140,7 +140,7 @@ 			& cachesCleaned 	-- Only propagate privdata Info from this chroot, nothing else. 	propprivdataonly (Chroot.Chroot d b ip h) =-		Chroot.Chroot d b (const $ ip onlyPrivData) h+		Chroot.Chroot d b (\c _ -> ip c onlyPrivData) h  -- | This property is automatically added to the chroot when building a -- disk image. It cleans any caches of information that can be omitted;

@@ -9,6 +9,7 @@  import System.Posix.Files import Data.List+import Data.Char  -- | Filesystems etc that can be used for a partition. data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | LinuxSwap@@ -81,11 +82,26 @@ 		return r 	cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage] +-- kpartx's output includes the device for the loop partition, and some+-- information about the whole disk loop device. In earlier versions,+-- this was simply the path to the loop device. But, in kpartx 0.6,+-- this changed to the major:minor of the block device. Either is handled+-- by this parser.  kpartxParse :: String -> [LoopDev] kpartxParse = mapMaybe (finddev . words) . lines   where-	finddev ("add":"map":ld:_:_:_:_:wd:_) = Just $ LoopDev -		{ partitionLoopDev = "/dev/mapper/" ++ ld-		, wholeDiskLoopDev = wd-		}+	finddev ("add":"map":ld:_:_:_:_:s:_) = do+		wd <- if isAbsolute s+			then Just s+			-- A loop partition name loop0pn corresponds to+			-- /dev/loop0. It would be more robust to check+			-- that the major:minor matches, but haskell's+			-- unix library lacks a way to do that.+			else case takeWhile isDigit (dropWhile (not . isDigit) ld) of+				[] -> Nothing+				n -> Just $ "/dev" </> "loop" ++ n+		Just $ LoopDev+			{ partitionLoopDev = "/dev/mapper/" ++ ld+			, wholeDiskLoopDev = wd+			} 	finddev _ = Nothing

@@ -128,9 +128,9 @@ builtFor :: System -> UseCcache -> RevertableProperty DebianLike UnixLike builtFor sys cc = go <!> deleted   where-	go = property' ("sbuild schroot for " ++ show sys) $-		\w -> case (schrootFromSystem sys, stdMirror sys) of-			(Just s, Just u)  -> ensureProperty w $+	go = Apt.withMirror goDesc $ \u -> property' goDesc $ \w ->+		case schrootFromSystem sys of+			Just s  -> ensureProperty w $ 				setupRevertableProperty $ built s u cc 			_ -> errorMessage 				("don't know how to debootstrap " ++ show sys)@@ -139,6 +139,7 @@ 			Just s  -> ensureProperty w $ 				undoRevertableProperty $ built s "dummy" cc 			Nothing -> noChange+	goDesc = "sbuild schroot for " ++ show sys  -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> UseCcache -> RevertableProperty DebianLike UnixLike@@ -499,11 +500,6 @@ schrootFromSystem system@(System _ arch) = 	extractSuite system 	>>= \suite -> return $ SbuildSchroot suite arch--stdMirror :: System -> Maybe Apt.Url-stdMirror (System (Debian _ _) _) = Just "http://deb.debian.org/debian"-stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/"-stdMirror _ = Nothing  schrootRoot :: SbuildSchroot -> FilePath schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ architectureToDebianArchString a

@@ -281,7 +281,7 @@ 			<!> 		doNothing -	chroot = Chroot.Chroot loc builder (Chroot.propagateChrootInfo chroot) h+	chroot = Chroot.Chroot loc builder Chroot.propagateChrootInfo h  -- | Sets up the service file for the container, and then starts -- it running.