-- | Maintainer: FĂ©lix Sipma module Propellor.Property.DebianMirror ( DebianPriority (..) , showPriority , mirror , RsyncExtra (..) , Method (..) , DebianMirror , debianMirrorHostName , debianMirrorSuites , debianMirrorArchitectures , debianMirrorSections , debianMirrorSourceBool , debianMirrorPriorities , debianMirrorMethod , debianMirrorKeyring , debianMirrorRsyncExtra , mkDebianMirror ) where import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Cron as Cron import qualified Propellor.Property.User as User 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" 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 DebianLike mirror mirror' = propertyList ("Debian mirror " ++ dir) $ props & Apt.installed ["debmirror"] & User.accountFor (User "debmirror") & File.dirExists dir & File.ownerGroup dir (User "debmirror") (Group "debmirror") & check (not . and <$> mapM suitemirrored suites) (cmdProperty "debmirror" args) `describe` "debmirror setup" & 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 $ _debianMirrorArchitectures mirror' , "--section", intercalate "," $ _debianMirrorSections mirror' , "--limit-priority", "\"" ++ priorityRegex (_debianMirrorPriorities mirror') ++ "\"" ] ++ (if _debianMirrorSourceBool mirror' then [] else ["--nosource"]) ++ [ "--host", _debianMirrorHostName mirror' , "--method", showMethod $ _debianMirrorMethod mirror' , "--rsync-extra", rsyncextraarg $ _debianMirrorRsyncExtra mirror' , "--keyring", _debianMirrorKeyring mirror' , dir ]