stable-backports can't be used :(

This commit is contained in:
Joey Hess 2014-04-13 17:50:44 -04:00
parent 38cd54a7ee
commit 90370dc575
4 changed files with 25 additions and 7 deletions

View File

@ -11,10 +11,12 @@ siteEnabled :: HostName -> ConfigFile -> RevertableProperty
siteEnabled hn cf = RevertableProperty enable disable siteEnabled hn cf = RevertableProperty enable disable
where where
enable = cmdProperty "a2ensite" ["--quiet", hn] enable = cmdProperty "a2ensite" ["--quiet", hn]
`describe` ("apache site enabled " ++ hn)
`requires` siteAvailable hn cf `requires` siteAvailable hn cf
`requires` installed `requires` installed
`onChange` reloaded `onChange` reloaded
disable = File.notPresent (siteCfg hn) disable = File.notPresent (siteCfg hn)
`describe` ("apache site disabled " ++ hn)
`onChange` cmdProperty "a2dissite" ["--quiet", hn] `onChange` cmdProperty "a2dissite" ["--quiet", hn]
`requires` installed `requires` installed
`onChange` reloaded `onChange` reloaded
@ -29,9 +31,11 @@ modEnabled :: String -> RevertableProperty
modEnabled modname = RevertableProperty enable disable modEnabled modname = RevertableProperty enable disable
where where
enable = cmdProperty "a2enmod" ["--quiet", modname] enable = cmdProperty "a2enmod" ["--quiet", modname]
`describe` ("apache module enabled " ++ modname)
`requires` installed `requires` installed
`onChange` reloaded `onChange` reloaded
disable = cmdProperty "a2dismod" ["--quiet", modname] disable = cmdProperty "a2dismod" ["--quiet", modname]
`describe` ("apache module disabled " ++ modname)
`requires` installed `requires` installed
`onChange` reloaded `onChange` reloaded

View File

@ -24,8 +24,8 @@ showSuite Unstable = "unstable"
showSuite Experimental = "experimental" showSuite Experimental = "experimental"
showSuite (DebianRelease r) = r showSuite (DebianRelease r) = r
backportSuite :: DebianSuite -> String backportSuite :: String
backportSuite suite = showSuite suite ++ "-backports" backportSuite = showSuite stableRelease ++ "-backports"
debLine :: String -> Url -> [Section] -> Line debLine :: String -> Url -> [Section] -> Line
debLine suite mirror sections = unwords $ debLine suite mirror sections = unwords $
@ -41,11 +41,11 @@ stdSections = ["main", "contrib", "non-free"]
binandsrc :: String -> DebianSuite -> [Line] binandsrc :: String -> DebianSuite -> [Line]
binandsrc url suite binandsrc url suite
| suite == Stable = [l, srcLine l, bl, srcLine bl] | isStable suite = [l, srcLine l, bl, srcLine bl]
| otherwise = [l, srcLine l] | otherwise = [l, srcLine l]
where where
l = debLine (showSuite suite) url stdSections l = debLine (showSuite suite) url stdSections
bl = debLine (backportSuite suite) url stdSections bl = debLine backportSuite url stdSections
debCdn :: DebianSuite -> [Line] debCdn :: DebianSuite -> [Line]
debCdn = binandsrc "http://cdn.debian.net/debian" debCdn = binandsrc "http://cdn.debian.net/debian"
@ -56,7 +56,7 @@ kernelOrg = binandsrc "http://mirrors.kernel.org/debian"
-- | Only available for Stable and Testing -- | Only available for Stable and Testing
securityUpdates :: DebianSuite -> [Line] securityUpdates :: DebianSuite -> [Line]
securityUpdates suite securityUpdates suite
| suite == Stable || suite == Testing = | isStable suite || suite == Testing =
let l = "deb http://security.debian.org/ " ++ showSuite suite ++ "/updates " ++ unwords stdSections let l = "deb http://security.debian.org/ " ++ showSuite suite ++ "/updates " ++ unwords stdSections
in [l, srcLine l] in [l, srcLine l]
| otherwise = [] | otherwise = []
@ -104,9 +104,10 @@ installed' params ps = robustly $ check (isInstallable ps) go
installedBackport :: [Package] -> Property installedBackport :: [Package] -> Property
installedBackport ps = withOS desc $ \o -> case o of installedBackport ps = withOS desc $ \o -> case o of
(Just (System (Debian suite) _)) ->
ensureProperty $ installed' ["-t", backportSuite suite, "-y"] ps
Nothing -> error "cannot install backports; os not declared" Nothing -> error "cannot install backports; os not declared"
(Just (System (Debian suite) _))
| isStable suite ->
ensureProperty $ installed' ["-t", backportSuite, "-y"] ps
_ -> error $ "backports not supported on " ++ show o _ -> error $ "backports not supported on " ++ show o
where where
desc = (unwords $ "apt installed backport":ps) desc = (unwords $ "apt installed backport":ps)

View File

@ -15,5 +15,12 @@ data Distribution
data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release
deriving (Show, Eq) deriving (Show, Eq)
-- | The release that currently corresponds to stable.
stableRelease :: DebianSuite
stableRelease = DebianRelease "wheezy"
isStable :: DebianSuite -> Bool
isStable s = s == Stable || s == stableRelease
type Release = String type Release = String
type Architecture = String type Architecture = String

View File

@ -86,6 +86,12 @@ hosts =
"840760dc-08f0-11e2-8c61-576b7e66acfd" "840760dc-08f0-11e2-8c61-576b7e66acfd"
[("turtle", "ssh://turtle.kitenet.net/~/lib/downloads/")] [("turtle", "ssh://turtle.kitenet.net/~/lib/downloads/")]
& Apt.buildDep ["git-annex"] `period` Daily & Apt.buildDep ["git-annex"] `period` Daily
-- rsync server for git-annex autobuilders
& Apt.installed ["rsync"]
& hasPrivContent "/etc/rsyncd.conf"
& hasPrivContent "/etc/rsyncd.secrets"
& "/etc/default/rsync" `File.containsLine` ""
`describe` "rsync server enabled"
& cname "tmp.kitenet.net" & cname "tmp.kitenet.net"
& JoeySites.annexWebSite hosts "/srv/git/joey/tmp.git" & JoeySites.annexWebSite hosts "/srv/git/joey/tmp.git"