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"