summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2017-03-24 13:56:39 -0400
committerJoey Hess2017-03-24 13:56:39 -0400
commitb738aa54eed266d72669bcdafdbba7df6bc795fa (patch)
tree47131d1ba25122e0642ef8966bc977f2b980b62c /src
parent5fc482fff3dcd9c809c275856adff1851b47160d (diff)
parent4d3a3caa6bd3ebea92bdcf3122922c881a4b2a3a (diff)
Merge branch 'master' into joeyconfig
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property/Apt.hs64
-rw-r--r--src/Propellor/Property/Sbuild.hs12
-rw-r--r--src/Propellor/Property/Tor.hs1
3 files changed, 55 insertions, 22 deletions
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index c681eee6..686ddb6c 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,37 @@ 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)
+
+-- | 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 (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
@@ -61,8 +94,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 =<< getMirror
-- | Only available for Stable and Testing
securityUpdates :: SourcesGenerator
@@ -72,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) _)) ->
@@ -88,11 +122,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 </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 @@ suiteAvailablePinned s pin = available <!> unavailable
& 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"
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index aaa83e6f..00109381 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.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 @@ 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
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index 710007cb..8794bc7f 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -57,6 +57,7 @@ named n = configured [("Nickname", n')]
-- and ed25519_master_id_secret_key from privdata.
torPrivKey :: Context -> Property (HasInfo + DebianLike)
torPrivKey context = mconcat (map go keyfiles)
+ `onChange` restarted
`requires` torPrivKeyDirExists
where
keyfiles = map (torPrivKeyDir </>)