summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/DebianMirror.hs
diff options
context:
space:
mode:
authorFélix Sipma2015-11-20 17:53:08 +0100
committerJoey Hess2015-11-21 13:19:27 -0400
commitf68b34e166083f150b6122efcfd1d1e78cd26eeb (patch)
tree9a78f798516ce7722f20c2f37103acb8790f21ea /src/Propellor/Property/DebianMirror.hs
parent5a228385a648219a2a38dcec80da2f86f0b25cb7 (diff)
DebianMirror: add DebianMirror type
(cherry picked from commit 82d949506dbadabff7d62de85a2f601b9d5755cc)
Diffstat (limited to 'src/Propellor/Property/DebianMirror.hs')
-rw-r--r--src/Propellor/Property/DebianMirror.hs108
1 files changed, 92 insertions, 16 deletions
diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
index 9c80050b..61546424 100644
--- a/src/Propellor/Property/DebianMirror.hs
+++ b/src/Propellor/Property/DebianMirror.hs
@@ -1,10 +1,22 @@
-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
module Propellor.Property.DebianMirror
- ( DebianPriority(..)
+ ( DebianPriority (..)
, showPriority
, mirror
- , mirrorCdn
+ , RsyncExtra (..)
+ , Method (..)
+ , DebianMirror
+ , setDebianMirrorHostName
+ , setDebianMirrorSuites
+ , setDebianMirrorArchitectures
+ , setDebianMirrorSections
+ , setDebianMirrorSourceBool
+ , setDebianMirrorPriorities
+ , setDebianMirrorMethod
+ , setDebianMirrorKeyring
+ , setDebianMirrorRsyncExtra
+ , mkDebianMirror
) where
import Propellor.Base
@@ -36,8 +48,73 @@ showRsyncExtra Indices = "indices"
showRsyncExtra Tools = "tools"
showRsyncExtra Trace = "trace"
-mirror :: HostName -> FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> [RsyncExtra] -> Cron.Times -> Property NoInfo
-mirror hn dir suites archs sections source priorities rsyncextras crontimes = propertyList
+data Method = Ftp | Http | Https | Rsync | MirrorFile
+
+showMethod :: Method -> String
+showMethod Ftp = "ftp"
+showMethod Http = "http"
+showMethod Https = "https"
+showMethod Rsync = "rsync"
+showMethod MirrorFile = "file"
+
+data DebianMirror = DebianMirror
+ { debianMirrorHostName :: HostName
+ , debianMirrorDir :: FilePath
+ , debianMirrorSuites :: [DebianSuite]
+ , debianMirrorArchitectures :: [Architecture]
+ , debianMirrorSections :: [Apt.Section]
+ , debianMirrorSourceBool :: Bool
+ , debianMirrorPriorities :: [DebianPriority]
+ , debianMirrorMethod :: Method
+ , debianMirrorKeyring :: FilePath
+ , debianMirrorRsyncExtra :: [RsyncExtra]
+ , debianMirrorCronTimes :: Cron.Times
+ }
+
+mkDebianMirror :: FilePath -> Cron.Times -> DebianMirror
+mkDebianMirror dir crontimes = DebianMirror
+ { debianMirrorHostName = "httpredir.debian.org"
+ , debianMirrorDir = dir
+ , debianMirrorSuites = []
+ , debianMirrorArchitectures = []
+ , debianMirrorSections = []
+ , debianMirrorSourceBool = False
+ , debianMirrorPriorities = []
+ , debianMirrorMethod = Http
+ , debianMirrorKeyring = "/usr/share/keyrings/debian-archive-keyring.gpg"
+ , debianMirrorRsyncExtra = [Trace]
+ , debianMirrorCronTimes = crontimes
+ }
+
+setDebianMirrorHostName :: HostName -> DebianMirror -> DebianMirror
+setDebianMirrorHostName hn m = m { debianMirrorHostName = hn }
+
+setDebianMirrorSuites :: [DebianSuite] -> DebianMirror -> DebianMirror
+setDebianMirrorSuites s m = m { debianMirrorSuites = s }
+
+setDebianMirrorArchitectures :: [Architecture] -> DebianMirror -> DebianMirror
+setDebianMirrorArchitectures a m = m { debianMirrorArchitectures = a }
+
+setDebianMirrorSections :: [Apt.Section] -> DebianMirror -> DebianMirror
+setDebianMirrorSections s m = m { debianMirrorSections = s }
+
+setDebianMirrorSourceBool :: Bool -> DebianMirror -> DebianMirror
+setDebianMirrorSourceBool s m = m { debianMirrorSourceBool = s }
+
+setDebianMirrorPriorities :: [DebianPriority] -> DebianMirror -> DebianMirror
+setDebianMirrorPriorities p m = m { debianMirrorPriorities = p }
+
+setDebianMirrorMethod :: Method -> DebianMirror -> DebianMirror
+setDebianMirrorMethod me m = m { debianMirrorMethod = me }
+
+setDebianMirrorKeyring :: FilePath -> DebianMirror -> DebianMirror
+setDebianMirrorKeyring k m = m { debianMirrorKeyring = k }
+
+setDebianMirrorRsyncExtra :: [RsyncExtra] -> DebianMirror -> DebianMirror
+setDebianMirrorRsyncExtra r m = m { debianMirrorRsyncExtra = r }
+
+mirror :: DebianMirror -> Property NoInfo
+mirror mirror' = propertyList
("Debian mirror " ++ dir)
[ Apt.installed ["debmirror"]
, User.accountFor (User "debmirror")
@@ -45,10 +122,12 @@ mirror hn dir suites archs sections source priorities rsyncextras crontimes = pr
, File.ownerGroup dir (User "debmirror") (Group "debmirror")
, check (not . and <$> mapM suitemirrored suites) $ cmdProperty "debmirror" args
`describe` "debmirror setup"
- , Cron.niceJob ("debmirror_" ++ dir) crontimes (User "debmirror") "/" $
+ , Cron.niceJob ("debmirror_" ++ dir) (debianMirrorCronTimes mirror') (User "debmirror") "/" $
unwords ("/usr/bin/debmirror" : args)
]
where
+ dir = debianMirrorDir mirror'
+ suites = debianMirrorSuites mirror'
suitemirrored suite = doesDirectoryExist $ dir </> "dists" </> Apt.showSuite suite
architecturearg = intercalate ","
suitearg = intercalate "," $ map Apt.showSuite suites
@@ -57,19 +136,16 @@ mirror hn dir suites archs sections source priorities rsyncextras crontimes = pr
rsyncextraarg res = intercalate "," $ map showRsyncExtra res
args =
[ "--dist" , suitearg
- , "--arch", architecturearg archs
- , "--section", intercalate "," sections
- , "--limit-priority", "\"" ++ priorityRegex priorities ++ "\""
+ , "--arch", architecturearg (debianMirrorArchitectures mirror')
+ , "--section", intercalate "," (debianMirrorSections mirror')
+ , "--limit-priority", "\"" ++ priorityRegex (debianMirrorPriorities mirror') ++ "\""
]
++
- (if source then [] else ["--nosource"])
+ (if (debianMirrorSourceBool mirror') then [] else ["--nosource"])
++
- [ "--host", hn
- , "--method", "http"
- , "--rsync-extra", rsyncextraarg rsyncextras
- , "--keyring", "/usr/share/keyrings/debian-archive-keyring.gpg"
+ [ "--host", debianMirrorHostName mirror'
+ , "--method", showMethod $ debianMirrorMethod mirror'
+ , "--rsync-extra", rsyncextraarg $ debianMirrorRsyncExtra mirror'
+ , "--keyring", debianMirrorKeyring mirror'
, dir
]
-
-mirrorCdn :: FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> [RsyncExtra] -> Cron.Times -> Property NoInfo
-mirrorCdn = mirror "httpredir.debian.org"