From fed18bc60db2f262363cb4b802bb11ea6d881621 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 18 Mar 2017 23:51:09 -0400 Subject: Tor: Restart daemon after installing private key. --- src/Propellor/Property/Tor.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs index 24d5b687..849c60d0 100644 --- a/src/Propellor/Property/Tor.hs +++ b/src/Propellor/Property/Tor.hs @@ -56,6 +56,7 @@ named n = configured [("Nickname", n')] torPrivKey :: Context -> Property (HasInfo + DebianLike) torPrivKey context = f `File.hasPrivContent` context `onChange` File.ownerGroup f user (userGroup user) + `onChange` restarted `requires` torPrivKeyDirExists where f = torPrivKeyDir "secret_id_key" -- cgit v1.2.3 From 21eaec2416dc44a9341699e0772d54397d5f5201 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Mar 2017 07:58:23 -0700 Subject: add HostMirror info type --- src/Propellor/Property/Apt.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index c681eee6..70b9474e 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -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,6 +15,23 @@ import Propellor.Base 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) + +getHostMirror :: Propellor Url +getHostMirror = do + mirrorInfo <- getHostMirrorInfo + osInfo <- getOS + return $ case (osInfo, mirrorInfo) of + (_, Just (HostMirror u)) -> u + (Just (System (Debian _ _) _), _) -> + "http://deb.debian.org/debian" + _ -> error "no Apt mirror defined for this host or OS" + where + getHostMirrorInfo :: Propellor (Maybe HostMirror) + getHostMirrorInfo = fromInfoVal <$> askInfo sourcesList :: FilePath sourcesList = "/etc/apt/sources.list" -- cgit v1.2.3 From 2cdf59fadde60249491d7bb88a3625c580d2027a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Mar 2017 08:15:32 -0700 Subject: add withHostMirror helper --- src/Propellor/Property/Apt.hs | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 70b9474e..29f453a9 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -33,6 +33,11 @@ getHostMirror = do getHostMirrorInfo :: Propellor (Maybe HostMirror) getHostMirrorInfo = fromInfoVal <$> askInfo +withHostMirror :: Desc -> (Url -> Property DebianLike) -> Property DebianLike +withHostMirror desc mkp = property' desc $ \w -> do + u <- getHostMirror + ensureProperty w (mkp u) + sourcesList :: FilePath sourcesList = "/etc/apt/sources.list" -- cgit v1.2.3 From aa5828aa586a4586b1c9ea0a207776869a256533 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Mar 2017 08:15:52 -0700 Subject: replace use of debCdn in Apt.hs --- src/Propellor/Property/Apt.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 29f453a9..2f4035a9 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -112,11 +112,12 @@ stdSourcesListFor suite = stdSourcesList' suite [] -- Note that if a Property needs to enable an apt source, it's better -- to do so via a separate file in 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 $ + withHostMirror 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 @@ -144,23 +145,24 @@ suiteAvailablePinned s pin = available unavailable & File.notPresent prefFile setSourcesFile :: Property Debian - setSourcesFile = withOS (desc True) $ \w o -> case o of + setSourcesFile = tightenTargets $ withHostMirror (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" -- cgit v1.2.3 From e3f58a00132dcab5504086efd980efe582932c96 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Mar 2017 08:16:21 -0700 Subject: replace debCdn with stdArchiveLines Though stdArchiveLines is not used in Apt.hs, this is the logical replacement for the old debCdn property. --- src/Propellor/Property/Apt.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 2f4035a9..f38a479d 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -85,8 +85,8 @@ binandsrc url suite = catMaybes bs <- backportSuite suite return $ debLine bs url stdSections -debCdn :: SourcesGenerator -debCdn = binandsrc "http://deb.debian.org/debian" +stdArchiveLines :: Propellor SourcesGenerator +stdArchiveLines = return . binandsrc =<< getHostMirror -- | Only available for Stable and Testing securityUpdates :: SourcesGenerator -- cgit v1.2.3 From 92497f99f01411e618df92dd1a6f82ce63d3854d Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Mar 2017 08:19:43 -0700 Subject: add Ubuntu std mirror to Apt.hs --- src/Propellor/Property/Apt.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index f38a479d..b86a6838 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -27,7 +27,9 @@ getHostMirror = do return $ case (osInfo, mirrorInfo) of (_, Just (HostMirror u)) -> u (Just (System (Debian _ _) _), _) -> - "http://deb.debian.org/debian" + "http://deb.debian.org/debian" + (Just (System (Buntish _) _), _) -> + "mirror://mirrors.ubuntu.com/" _ -> error "no Apt mirror defined for this host or OS" where getHostMirrorInfo :: Propellor (Maybe HostMirror) -- cgit v1.2.3 From 26d1e681a06fcb5a8575cdf9956537b583ba5062 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Mar 2017 08:26:02 -0700 Subject: improve error msg from Apt.getHostMirror --- src/Propellor/Property/Apt.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index b86a6838..abec1357 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -30,6 +30,8 @@ getHostMirror = do "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 getHostMirrorInfo :: Propellor (Maybe HostMirror) -- cgit v1.2.3 From ec3615fb6789ed6b911bf436147db597a38e8aa1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Mar 2017 11:16:55 -0700 Subject: sbuild: use Apt.withHostMirror --- src/Propellor/Property/Sbuild.hs | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index aaa83e6f..5755748a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -128,9 +128,9 @@ data UseCcache = UseCcache | NoCcache 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.withHostMirror 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 @@ builtFor sys cc = go deleted 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 @@ -500,11 +501,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 -- cgit v1.2.3 From deda66755b5f4075909db3a5dcf45abb2c941f29 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Mar 2017 11:22:05 -0700 Subject: add Apt.hostMirrorIs --- src/Propellor/Property/Apt.hs | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index abec1357..009b426b 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -20,6 +20,11 @@ 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) +hostMirrorIs :: Url -> Property (HasInfo + UnixLike) +hostMirrorIs u = pureInfoProperty (u ++ " apt mirror selected") + (InfoVal (HostMirror u)) + getHostMirror :: Propellor Url getHostMirror = do mirrorInfo <- getHostMirrorInfo -- cgit v1.2.3 From 9d54717be5c894957bfc770315d45a13cc19cfe2 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Mar 2017 11:43:55 -0700 Subject: shorten names of mirror properties --- src/Propellor/Property/Apt.hs | 30 +++++++++++++++--------------- src/Propellor/Property/Sbuild.hs | 2 +- 2 files changed, 16 insertions(+), 16 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 009b426b..8f4678df 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -21,13 +21,13 @@ data HostMirror = HostMirror Url deriving (Eq, Show, Typeable) -- | Indicate host's preferred apt mirror (e.g. an apt cacher on the host's LAN) -hostMirrorIs :: Url -> Property (HasInfo + UnixLike) -hostMirrorIs u = pureInfoProperty (u ++ " apt mirror selected") +mirror :: Url -> Property (HasInfo + UnixLike) +mirror u = pureInfoProperty (u ++ " apt mirror selected") (InfoVal (HostMirror u)) -getHostMirror :: Propellor Url -getHostMirror = do - mirrorInfo <- getHostMirrorInfo +getMirror :: Propellor Url +getMirror = do + mirrorInfo <- getMirrorInfo osInfo <- getOS return $ case (osInfo, mirrorInfo) of (_, Just (HostMirror u)) -> u @@ -39,12 +39,12 @@ getHostMirror = do error ("no Apt mirror defined for " ++ show dist) _ -> error "no Apt mirror defined for this host or OS" where - getHostMirrorInfo :: Propellor (Maybe HostMirror) - getHostMirrorInfo = fromInfoVal <$> askInfo + getMirrorInfo :: Propellor (Maybe HostMirror) + getMirrorInfo = fromInfoVal <$> askInfo -withHostMirror :: Desc -> (Url -> Property DebianLike) -> Property DebianLike -withHostMirror desc mkp = property' desc $ \w -> do - u <- getHostMirror +withMirror :: Desc -> (Url -> Property DebianLike) -> Property DebianLike +withMirror desc mkp = property' desc $ \w -> do + u <- getMirror ensureProperty w (mkp u) sourcesList :: FilePath @@ -70,8 +70,8 @@ stableUpdatesSuite (Stable s) = Just (s ++ "-updates") 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 @@ -95,7 +95,7 @@ binandsrc url suite = catMaybes return $ debLine bs url stdSections stdArchiveLines :: Propellor SourcesGenerator -stdArchiveLines = return . binandsrc =<< getHostMirror +stdArchiveLines = return . binandsrc =<< getMirror -- | Only available for Stable and Testing securityUpdates :: SourcesGenerator @@ -122,7 +122,7 @@ stdSourcesListFor suite = stdSourcesList' suite [] -- to do so via a separate file in stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian stdSourcesList' suite more = tightenTargets $ - withHostMirror desc $ \u -> setSourcesList + withMirror desc $ \u -> setSourcesList (concatMap (\gen -> gen suite) (generators u)) where generators u = [binandsrc u, securityUpdates] ++ more @@ -154,7 +154,7 @@ suiteAvailablePinned s pin = available unavailable & File.notPresent prefFile setSourcesFile :: Property Debian - setSourcesFile = tightenTargets $ withHostMirror (desc True) $ \u -> + setSourcesFile = tightenTargets $ withMirror (desc True) $ \u -> withOS (desc True) $ \w o -> case o of (Just (System (Debian _ hostSuite) _)) | s /= hostSuite -> ensureProperty w $ diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 5755748a..00109381 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -128,7 +128,7 @@ data UseCcache = UseCcache | NoCcache builtFor :: System -> UseCcache -> RevertableProperty DebianLike UnixLike builtFor sys cc = go deleted where - go = Apt.withHostMirror goDesc $ \u -> property' goDesc $ \w -> + go = Apt.withMirror goDesc $ \u -> property' goDesc $ \w -> case schrootFromSystem sys of Just s -> ensureProperty w $ setupRevertableProperty $ built s u cc -- cgit v1.2.3 From 49ab069466c1c042cad12ef9c74f1f03c65615a9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 19 Mar 2017 16:41:14 -0400 Subject: 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. --- debian/changelog | 9 +++++++++ ...Info_property_to_select_host__39__s_preferred_Apt_mirror.mdwn | 2 ++ src/Propellor/Property/Apt.hs | 5 +++-- 3 files changed, 14 insertions(+), 2 deletions(-) (limited to 'src/Propellor') diff --git a/debian/changelog b/debian/changelog index dd950ecb..ed0e2422 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,12 @@ +propellor (4.0.2) UNRELEASED; 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. + + -- Joey Hess Sun, 19 Mar 2017 16:37:27 -0400 + propellor (4.0.1) unstable; urgency=medium * Fix build with pre-AMP ghc. diff --git a/doc/todo/Info_property_to_select_host__39__s_preferred_Apt_mirror.mdwn b/doc/todo/Info_property_to_select_host__39__s_preferred_Apt_mirror.mdwn index e3702ab9..4cd76383 100644 --- a/doc/todo/Info_property_to_select_host__39__s_preferred_Apt_mirror.mdwn +++ b/doc/todo/Info_property_to_select_host__39__s_preferred_Apt_mirror.mdwn @@ -1,3 +1,5 @@ It would be good to have an info property, say `Apt.mirror`, which sets a host's preferred apt mirror. Then all properties in `Propellor.Property.Apt` would use this mirror when generating sources lists, falling back to the `deb.debian.org` default. The value of `Apt.mirror` could be an apt cache on the LAN, or a mirror that is known to be better than the Debian CDN from where the host is located. --[[spwhitton|user/spwhitton]] [[!tag user/spwhitton]] + +> [[merged|done]] thank you! --[[Joey]] diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 8f4678df..686ddb6c 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -105,8 +105,9 @@ securityUpdates suite 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) _)) -> -- cgit v1.2.3