add DebianMirror property.

Signed-off-by: Félix Sipma <felix.sipma@no-log.org>

1 files changed, 54 insertions, 0 deletions

diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
new file mode 100644
index 00000000..271b386e
--- /dev/null
+++ b/src/Propellor/Property/DebianMirror.hs
@@ -0,0 +1,54 @@
+module Propellor.Property.DebianMirror
+	( DebianPriority(..)
+	, showPriority
+	, mirror
+	) where
+
+import Propellor
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Cron as Cron
+
+import Data.List
+
+
+data DebianPriority = Essential | Required | Important | Standard | Optional | Extra
+	deriving (Show, Eq)
+
+showPriority :: DebianPriority -> String
+showPriority Essential = "essential"
+showPriority Required  = "required"
+showPriority Important = "important"
+showPriority Standard  = "standard"
+showPriority Optional  = "optional"
+showPriority Extra     = "extra"
+
+mirror :: FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> Cron.Times -> Property NoInfo
+mirror dir suites archs sections source priorities crontimes = propertyList
+	("Debian mirror " ++ dir)
+	[ Apt.installed ["debmirror"]
+	, File.dirExists dir
+	, check (not . and <$> mapM suitemirrored suites) $ cmdProperty "debmirror" args
+		`describe` "debmirror setup"
+	, Cron.niceJob ("debmirror_" ++ dir) crontimes (User "root") "/" $
+		unwords ("/usr/bin/debmirror" : args)
+	]
+  where
+	suitemirrored suite = doesDirectoryExist $ dir </> "dists" </> Apt.showSuite suite
+	architecturearg = intercalate ","
+	suitearg = intercalate "," $ map Apt.showSuite suites
+	priorityRegex pp = "(" ++ intercalate "|" (map showPriority pp) ++ ")"
+	args =
+		[ "--dist" , suitearg
+		, "--arch", architecturearg archs
+		, "--section", intercalate "," sections
+		, "--limit-priority", "\"" ++ priorityRegex priorities ++ "\""
+		]
+		++
+		(if source then [] else ["--nosource"])
+		++
+		[ "--host", "ftp.fr.debian.org"
+		, "--method", "http"
+		, "--keyring", "/usr/share/keyrings/debian-archive-keyring.gpg"
+		, dir
+		]