From 1d38d3d3a17ac0c89d172291e879b91f32f2d9e1 Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Fri, 20 Nov 2015 15:15:39 +0100 Subject: DebianMirror: debmirror --host argument should be a hostname, not an url (cherry picked from commit f0e374b4a43db750868f1ca4ccc465cee5691748) --- src/Propellor/Property/DebianMirror.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property/DebianMirror.hs') diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs index 6f1ff7b2..bdcade96 100644 --- a/src/Propellor/Property/DebianMirror.hs +++ b/src/Propellor/Property/DebianMirror.hs @@ -27,8 +27,8 @@ 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 +mirror :: HostName -> FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> Cron.Times -> Property NoInfo +mirror hn dir suites archs sections source priorities crontimes = propertyList ("Debian mirror " ++ dir) [ Apt.installed ["debmirror"] , User.accountFor (User "debmirror") @@ -53,11 +53,11 @@ mirror url dir suites archs sections source priorities crontimes = propertyList ++ (if source then [] else ["--nosource"]) ++ - [ "--host", url + [ "--host", hn , "--method", "http" , "--keyring", "/usr/share/keyrings/debian-archive-keyring.gpg" , dir ] mirrorCdn :: FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> Cron.Times -> Property NoInfo -mirrorCdn = mirror "http://httpredir.debian.org/debian" +mirrorCdn = mirror "httpredir.debian.org" -- cgit v1.3-2-g0d8e From 12c0dccd1952ed115f576a1d5616394ec981c13c Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Fri, 20 Nov 2015 15:18:15 +0100 Subject: DebianMirror: add a [RsyncExtra] argument (cherry picked from commit baff70140cbf3f6113439335b96f3016f261a6a0) --- src/Propellor/Property/DebianMirror.hs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property/DebianMirror.hs') diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs index bdcade96..9c80050b 100644 --- a/src/Propellor/Property/DebianMirror.hs +++ b/src/Propellor/Property/DebianMirror.hs @@ -27,8 +27,17 @@ showPriority Standard = "standard" showPriority Optional = "optional" showPriority Extra = "extra" -mirror :: HostName -> FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> Cron.Times -> Property NoInfo -mirror hn 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" + +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 ("Debian mirror " ++ dir) [ Apt.installed ["debmirror"] , User.accountFor (User "debmirror") @@ -44,6 +53,8 @@ mirror hn dir suites archs sections source priorities crontimes = propertyList 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 @@ -55,9 +66,10 @@ mirror hn dir suites archs sections source priorities crontimes = propertyList ++ [ "--host", hn , "--method", "http" + , "--rsync-extra", rsyncextraarg rsyncextras , "--keyring", "/usr/share/keyrings/debian-archive-keyring.gpg" , dir ] -mirrorCdn :: FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> Cron.Times -> Property NoInfo +mirrorCdn :: FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> [RsyncExtra] -> Cron.Times -> Property NoInfo mirrorCdn = mirror "httpredir.debian.org" -- cgit v1.3-2-g0d8e From f68b34e166083f150b6122efcfd1d1e78cd26eeb Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Fri, 20 Nov 2015 17:53:08 +0100 Subject: DebianMirror: add DebianMirror type (cherry picked from commit 82d949506dbadabff7d62de85a2f601b9d5755cc) --- src/Propellor/Property/DebianMirror.hs | 108 ++++++++++++++++++++++++++++----- 1 file changed, 92 insertions(+), 16 deletions(-) (limited to 'src/Propellor/Property/DebianMirror.hs') 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 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" -- cgit v1.3-2-g0d8e From f038460bfe1447fdbeaaa311fc42ccf4dee2b994 Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Sat, 21 Nov 2015 11:29:34 +0100 Subject: DebianMirror: use a lensy approach to set values of a DebianMirror (cherry picked from commit 359e449157f831bbd22a212d618b6762a58b47de) --- src/Propellor/Property/DebianMirror.hs | 126 +++++++++++++++++---------------- 1 file changed, 66 insertions(+), 60 deletions(-) (limited to 'src/Propellor/Property/DebianMirror.hs') diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs index 61546424..468cca32 100644 --- a/src/Propellor/Property/DebianMirror.hs +++ b/src/Propellor/Property/DebianMirror.hs @@ -7,15 +7,15 @@ module Propellor.Property.DebianMirror , RsyncExtra (..) , Method (..) , DebianMirror - , setDebianMirrorHostName - , setDebianMirrorSuites - , setDebianMirrorArchitectures - , setDebianMirrorSections - , setDebianMirrorSourceBool - , setDebianMirrorPriorities - , setDebianMirrorMethod - , setDebianMirrorKeyring - , setDebianMirrorRsyncExtra + , debianMirrorHostName + , debianMirrorSuites + , debianMirrorArchitectures + , debianMirrorSections + , debianMirrorSourceBool + , debianMirrorPriorities + , debianMirrorMethod + , debianMirrorKeyring + , debianMirrorRsyncExtra , mkDebianMirror ) where @@ -57,61 +57,67 @@ 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 + { _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 = "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 } +debianMirrorHostName :: HostName -> DebianMirror -> DebianMirror +debianMirrorHostName hn m = m { _debianMirrorHostName = hn } -setDebianMirrorSuites :: [DebianSuite] -> DebianMirror -> DebianMirror -setDebianMirrorSuites s m = m { debianMirrorSuites = s } +debianMirrorSuites :: [DebianSuite] -> DebianMirror -> DebianMirror +debianMirrorSuites s m = m { _debianMirrorSuites = s } -setDebianMirrorArchitectures :: [Architecture] -> DebianMirror -> DebianMirror -setDebianMirrorArchitectures a m = m { debianMirrorArchitectures = a } +debianMirrorArchitectures :: [Architecture] -> DebianMirror -> DebianMirror +debianMirrorArchitectures a m = m { _debianMirrorArchitectures = a } -setDebianMirrorSections :: [Apt.Section] -> DebianMirror -> DebianMirror -setDebianMirrorSections s m = m { debianMirrorSections = s } +debianMirrorSections :: [Apt.Section] -> DebianMirror -> DebianMirror +debianMirrorSections s m = m { _debianMirrorSections = s } -setDebianMirrorSourceBool :: Bool -> DebianMirror -> DebianMirror -setDebianMirrorSourceBool s m = m { debianMirrorSourceBool = s } +debianMirrorSourceBool :: Bool -> DebianMirror -> DebianMirror +debianMirrorSourceBool s m = m { _debianMirrorSourceBool = s } -setDebianMirrorPriorities :: [DebianPriority] -> DebianMirror -> DebianMirror -setDebianMirrorPriorities p m = m { debianMirrorPriorities = p } +debianMirrorPriorities :: [DebianPriority] -> DebianMirror -> DebianMirror +debianMirrorPriorities p m = m { _debianMirrorPriorities = p } -setDebianMirrorMethod :: Method -> DebianMirror -> DebianMirror -setDebianMirrorMethod me m = m { debianMirrorMethod = me } +debianMirrorMethod :: Method -> DebianMirror -> DebianMirror +debianMirrorMethod me m = m { _debianMirrorMethod = me } -setDebianMirrorKeyring :: FilePath -> DebianMirror -> DebianMirror -setDebianMirrorKeyring k m = m { debianMirrorKeyring = k } +debianMirrorKeyring :: FilePath -> DebianMirror -> DebianMirror +debianMirrorKeyring k m = m { _debianMirrorKeyring = k } -setDebianMirrorRsyncExtra :: [RsyncExtra] -> DebianMirror -> DebianMirror -setDebianMirrorRsyncExtra r m = m { debianMirrorRsyncExtra = r } +debianMirrorRsyncExtra :: [RsyncExtra] -> DebianMirror -> DebianMirror +debianMirrorRsyncExtra r m = m { _debianMirrorRsyncExtra = r } mirror :: DebianMirror -> Property NoInfo mirror mirror' = propertyList @@ -122,12 +128,12 @@ mirror mirror' = propertyList , 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") "/" $ + , Cron.niceJob ("debmirror_" ++ dir) (_debianMirrorCronTimes mirror') (User "debmirror") "/" $ unwords ("/usr/bin/debmirror" : args) ] where - dir = debianMirrorDir mirror' - suites = debianMirrorSuites mirror' + dir = _debianMirrorDir mirror' + suites = _debianMirrorSuites mirror' suitemirrored suite = doesDirectoryExist $ dir "dists" Apt.showSuite suite architecturearg = intercalate "," suitearg = intercalate "," $ map Apt.showSuite suites @@ -136,16 +142,16 @@ mirror mirror' = propertyList rsyncextraarg res = intercalate "," $ map showRsyncExtra res args = [ "--dist" , suitearg - , "--arch", architecturearg (debianMirrorArchitectures mirror') - , "--section", intercalate "," (debianMirrorSections mirror') - , "--limit-priority", "\"" ++ priorityRegex (debianMirrorPriorities mirror') ++ "\"" + , "--arch", architecturearg $ _debianMirrorArchitectures mirror' + , "--section", intercalate "," $ _debianMirrorSections mirror' + , "--limit-priority", "\"" ++ priorityRegex (_debianMirrorPriorities mirror') ++ "\"" ] ++ - (if (debianMirrorSourceBool mirror') then [] else ["--nosource"]) + (if _debianMirrorSourceBool mirror' then [] else ["--nosource"]) ++ - [ "--host", debianMirrorHostName mirror' - , "--method", showMethod $ debianMirrorMethod mirror' - , "--rsync-extra", rsyncextraarg $ debianMirrorRsyncExtra mirror' - , "--keyring", debianMirrorKeyring mirror' + [ "--host", _debianMirrorHostName mirror' + , "--method", showMethod $ _debianMirrorMethod mirror' + , "--rsync-extra", rsyncextraarg $ _debianMirrorRsyncExtra mirror' + , "--keyring", _debianMirrorKeyring mirror' , dir ] -- cgit v1.3-2-g0d8e