summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/DebianMirror.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/DebianMirror.hs')
-rw-r--r--src/Propellor/Property/DebianMirror.hs124
1 files changed, 109 insertions, 15 deletions
diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
index 6f1ff7b2..468cca32 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
+ , debianMirrorHostName
+ , debianMirrorSuites
+ , debianMirrorArchitectures
+ , debianMirrorSections
+ , debianMirrorSourceBool
+ , debianMirrorPriorities
+ , debianMirrorMethod
+ , debianMirrorKeyring
+ , debianMirrorRsyncExtra
+ , mkDebianMirror
) where
import Propellor.Base
@@ -27,8 +39,88 @@ showPriority Standard = "standard"
showPriority Optional = "optional"
showPriority Extra = "extra"
-mirror :: Apt.Url -> FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> Cron.Times -> Property NoInfo
-mirror url dir suites archs sections source priorities crontimes = propertyList
+data RsyncExtra = Doc | Indices | Tools | Trace
+ deriving (Show, Eq)
+
+showRsyncExtra :: RsyncExtra -> String
+showRsyncExtra Doc = "doc"
+showRsyncExtra Indices = "indices"
+showRsyncExtra Tools = "tools"
+showRsyncExtra Trace = "trace"
+
+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"
+
+-- | To get a new DebianMirror and set options, use:
+--
+-- > mkDebianMirror mymirrordir mycrontimes
+-- > . debianMirrorHostName "otherhostname"
+-- > . debianMirrorSourceBool True
+
+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
+ }
+
+debianMirrorHostName :: HostName -> DebianMirror -> DebianMirror
+debianMirrorHostName hn m = m { _debianMirrorHostName = hn }
+
+debianMirrorSuites :: [DebianSuite] -> DebianMirror -> DebianMirror
+debianMirrorSuites s m = m { _debianMirrorSuites = s }
+
+debianMirrorArchitectures :: [Architecture] -> DebianMirror -> DebianMirror
+debianMirrorArchitectures a m = m { _debianMirrorArchitectures = a }
+
+debianMirrorSections :: [Apt.Section] -> DebianMirror -> DebianMirror
+debianMirrorSections s m = m { _debianMirrorSections = s }
+
+debianMirrorSourceBool :: Bool -> DebianMirror -> DebianMirror
+debianMirrorSourceBool s m = m { _debianMirrorSourceBool = s }
+
+debianMirrorPriorities :: [DebianPriority] -> DebianMirror -> DebianMirror
+debianMirrorPriorities p m = m { _debianMirrorPriorities = p }
+
+debianMirrorMethod :: Method -> DebianMirror -> DebianMirror
+debianMirrorMethod me m = m { _debianMirrorMethod = me }
+
+debianMirrorKeyring :: FilePath -> DebianMirror -> DebianMirror
+debianMirrorKeyring k m = m { _debianMirrorKeyring = k }
+
+debianMirrorRsyncExtra :: [RsyncExtra] -> DebianMirror -> DebianMirror
+debianMirrorRsyncExtra r m = m { _debianMirrorRsyncExtra = r }
+
+mirror :: DebianMirror -> Property NoInfo
+mirror mirror' = propertyList
("Debian mirror " ++ dir)
[ Apt.installed ["debmirror"]
, User.accountFor (User "debmirror")
@@ -36,28 +128,30 @@ mirror url dir suites archs sections source priorities crontimes = propertyList
, 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
priorityRegex pp = "(" ++ intercalate "|" (map showPriority pp) ++ ")"
+ rsyncextraarg [] = "none"
+ 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", url
- , "--method", "http"
- , "--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] -> Cron.Times -> Property NoInfo
-mirrorCdn = mirror "http://httpredir.debian.org/debian"