From b84c9bbb7c9db688118ad756c1c43ef034fd98fb Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Sun, 13 Sep 2015 00:46:49 +0200 Subject: Follow some hlint suggestions. --- src/Propellor/Info.hs | 2 +- src/Propellor/Message.hs | 3 +-- src/Propellor/PrivData.hs | 6 +++--- src/Propellor/PropAccum.hs | 2 +- src/Propellor/Property.hs | 3 +-- src/Propellor/Property/Apt.hs | 6 +++--- src/Propellor/Property/ConfFile.hs | 3 +-- src/Propellor/Property/Debootstrap.hs | 4 ++-- src/Propellor/Property/DiskImage.hs | 12 +++++------- src/Propellor/Property/Dns.hs | 6 +++--- src/Propellor/Property/Docker.hs | 9 ++++----- src/Propellor/Property/File.hs | 2 +- src/Propellor/Shim.hs | 2 +- src/Propellor/Spin.hs | 6 +++--- src/Propellor/Types.hs | 2 +- src/Propellor/Types/Container.hs | 4 ++-- 16 files changed, 33 insertions(+), 39 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs index b9436e58..74614a1b 100644 --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -87,7 +87,7 @@ aliasMap = M.fromList . concat . map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ getInfo $ hostInfo h) findHost :: [Host] -> HostName -> Maybe Host -findHost l hn = maybe (findAlias l hn) Just (findHostNoAlias l hn) +findHost l hn = (findHostNoAlias l hn) <|> (findAlias l hn) findHostNoAlias :: [Host] -> HostName -> Maybe Host findHostNoAlias l hn = M.lookup hn (hostMap l) diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index f62d3cd9..94892da8 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -112,8 +112,7 @@ checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG" go (Just "1") = enableDebugMode go (Just _) = noop go Nothing = whenM (doesDirectoryExist ".git") $ - whenM (any (== "1") . lines <$> getgitconfig) $ - enableDebugMode + whenM (elem "1" . lines <$> getgitconfig) enableDebugMode getgitconfig = catchDefaultIO "" $ readProcess "git" ["config", "propellor.debug"] diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index 9aa6f380..cbb296ce 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -187,16 +187,16 @@ listPrivDataFields hosts = do showSet $ map (\(f, c) -> (f, c, join $ M.lookup (f, c) descmap)) missing where header = ["Field", "Context", "Used by"] - mkrow k@(field, (Context context)) = + mkrow k@(field, Context context) = [ shellEscape $ show field , shellEscape context , intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby ] mkhostmap host mkv = M.fromList $ map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d)) $ S.toList $ fromPrivInfo $ getInfo $ hostInfo host - usedby = M.unionsWith (++) $ map (\h -> mkhostmap h $ const $ [hostName h]) hosts + usedby = M.unionsWith (++) $ map (\h -> mkhostmap h $ const [hostName h]) hosts wantedmap = M.fromList $ zip (M.keys usedby) (repeat "") - descmap = M.unions $ map (\h -> mkhostmap h id) hosts + descmap = M.unions $ map (`mkhostmap` id) hosts section desc = putStrLn $ "\n" ++ desc showtable rows = do putStr $ unlines $ formatTable $ tableWithHeader header rows diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index d2736b50..4b2a5ddb 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -48,7 +48,7 @@ class PropAccum h where instance PropAccum Host where (Host hn ps is) & p = Host hn (ps ++ [toProp p]) (is <> getInfoRecursive p) - (Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) + (Host hn ps is) &^ p = Host hn (toProp p : ps) (getInfoRecursive p <> is) getProperties = hostProperties diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index b90d5b86..e8d70a80 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -67,8 +67,7 @@ onChangeFlagOnFail -> Property x -> Property y -> CombinedType (Property x) (Property y) -onChangeFlagOnFail flagfile p1 p2 = - combineWith go p1 p2 +onChangeFlagOnFail flagfile = combineWith go where go s1 s2 = do r1 <- s1 diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 81005f1a..e89ea6a2 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -80,7 +80,7 @@ securityUpdates suite -- Since the CDN is sometimes unreliable, also adds backup lines using -- kernel.org. stdSourcesList :: Property NoInfo -stdSourcesList = withOS ("standard sources.list") $ \o -> +stdSourcesList = withOS "standard sources.list" $ \o -> case o of (Just (System (Debian suite) _)) -> ensureProperty $ stdSourcesListFor suite @@ -187,7 +187,7 @@ robustly p = adjustPropertySatisfy p $ \satisfy -> do isInstallable :: [Package] -> IO Bool isInstallable ps = do l <- isInstalled' ps - return $ any (== False) l && not (null l) + return $ elem False l && not (null l) isInstalled :: Package -> IO Bool isInstalled p = (== [True]) <$> isInstalled' [p] @@ -197,7 +197,7 @@ isInstalled p = (== [True]) <$> isInstalled' [p] -- even vary. If apt does not know about a package at all, it will not -- be included in the result list. isInstalled' :: [Package] -> IO [Bool] -isInstalled' ps = catMaybes . map parse . lines <$> policy +isInstalled' ps = (mapMaybe parse . lines) <$> policy where parse l | "Installed: (none)" `isInfixOf` l = Just False diff --git a/src/Propellor/Property/ConfFile.hs b/src/Propellor/Property/ConfFile.hs index 066848bb..0bc1b76d 100644 --- a/src/Propellor/Property/ConfFile.hs +++ b/src/Propellor/Property/ConfFile.hs @@ -38,8 +38,7 @@ adjustSection -> InsertSection -> FilePath -> Property NoInfo -adjustSection desc start past adjust insert f = - fileProperty desc go f +adjustSection desc start past adjust insert = fileProperty desc go where go ls = let (pre, wanted, post) = foldl' find ([], [], []) ls in if null wanted diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index a46451ef..74da68b4 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -158,10 +158,10 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do let indexfile = tmpd "index.html" unlessM (download baseurl indexfile) $ errorMessage $ "Failed to download " ++ baseurl - urls <- reverse . sort -- highest version first + urls <- (sortBy (flip compare) -- highest version first . filter ("debootstrap_" `isInfixOf`) . filter (".tar." `isInfixOf`) - . extractUrls baseurl <$> + . extractUrls baseurl) <$> readFileStrictAnyEncoding indexfile nukeFile indexfile diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 35082eec..8d35991e 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -119,7 +119,7 @@ imageBuiltFrom img chrootdir tabletype partspec final = mkimg rmimg liftIO $ unmountBelow chrootdir szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize <$> liftIO (dirSizes chrootdir) - let calcsz = \mnts -> maybe defSz fudge . getMountSz szm mnts + let calcsz mnts = maybe defSz fudge . getMountSz szm mnts -- tie the knot! let (mnts, t) = fitChrootSize tabletype partspec (map (calcsz mnts) mnts) ensureProperty $ @@ -131,8 +131,7 @@ imageBuiltFrom img chrootdir tabletype partspec final = mkimg rmimg rmimg = File.notPresent img partitionsPopulated :: FilePath -> [MountPoint] -> [FilePath] -> Property NoInfo -partitionsPopulated chrootdir mnts devs = property desc $ - mconcat $ map (uncurry go) (zip mnts devs) +partitionsPopulated chrootdir mnts devs = property desc $ mconcat $ zipWith go mnts devs where desc = "partitions populated from " ++ chrootdir @@ -200,8 +199,7 @@ getMountSz _ _ Nothing = Nothing getMountSz szm l (Just mntpt) = fmap (`reducePartSize` childsz) (M.lookup mntpt szm) where - childsz = mconcat $ catMaybes $ - map (getMountSz szm l) (filter (isChild mntpt) l) + childsz = mconcat $ mapMaybe (getMountSz szm l) (filter (isChild mntpt) l) isChild :: FilePath -> MountPoint -> Bool isChild mntpt (Just d) @@ -274,7 +272,7 @@ extended :: PartSpec -> PartSpec extended s = adjustp s $ \p -> p { partType = Extended } adjustp :: PartSpec -> (Partition -> Partition) -> PartSpec -adjustp (mp, p) f = (mp, \sz -> f (p sz)) +adjustp (mp, p) f = (mp, f . p) -- | The constructor for each Partition is passed the size of the files -- from the chroot that will be put in that partition. @@ -282,7 +280,7 @@ fitChrootSize :: TableType -> [PartSpec] -> [PartSize] -> ([MountPoint], PartTab fitChrootSize tt l basesizes = (mounts, parttable) where (mounts, sizers) = unzip l - parttable = PartTable tt (map (uncurry id) (zip sizers basesizes)) + parttable = PartTable tt (zipWith id sizers basesizes) -- | A pair of properties. The first property is satisfied within the -- chroot, and is typically used to download the boot loader. diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index 6051ba63..d854ec52 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -97,7 +97,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs = , confFile = mknamedconffile zonefile , confMasters = [] , confAllowTransfer = nub $ - concatMap (\h -> hostAddresses h hosts) $ + concatMap (`hostAddresses` hosts) $ secondaries ++ nssecondaries , confLines = [] } @@ -199,7 +199,7 @@ secondaryFor masters hosts domain = setup cleanup { confDomain = domain , confDnsServerType = Secondary , confFile = "db." ++ domain - , confMasters = concatMap (\m -> hostAddresses m hosts) masters + , confMasters = concatMap (`hostAddresses` hosts) masters , confAllowTransfer = [] , confLines = [] } @@ -425,7 +425,7 @@ type WarningMessage = String -- Does not include SSHFP records. genZone :: [Host] -> M.Map HostName Host -> Domain -> SOA -> (Zone, [WarningMessage]) genZone inzdomain hostmap zdomain soa = - let (warnings, zhosts) = partitionEithers $ concat $ map concat + let (warnings, zhosts) = partitionEithers $ concatMap concat [ map hostips inzdomain , map hostrecords inzdomain , map addcnames (M.elems hostmap) diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index e24d58d4..fc12cf8c 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -213,7 +213,7 @@ garbageCollected = propertyList "docker garbage collected" where gccontainers = property "docker containers garbage collected" $ liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers) - gcimages = property "docker images garbage collected" $ do + gcimages = property "docker images garbage collected" $ liftIO $ report <$> (mapM removeImage =<< listImages) -- | Tweaks a container to work well with docker. @@ -471,8 +471,7 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope restartcontainer = do oldimage <- liftIO $ - fromMaybe (toImageID image) . fmap toImageID <$> - commitContainer cid + maybe (toImageID image) toImageID <$> commitContainer cid void $ liftIO $ removeContainer cid go oldimage @@ -631,8 +630,8 @@ data ContainerFilter = RunningContainers | AllContainers -- | Only lists propellor managed containers. listContainers :: ContainerFilter -> IO [ContainerId] listContainers status = - catMaybes . map toContainerId . concat . map (split ",") - . catMaybes . map (lastMaybe . words) . lines + (mapMaybe toContainerId . concatMap (split ",") + . mapMaybe (lastMaybe . words) . lines) <$> readProcess dockercmd ps where ps diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index adced166..4e074eee 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -103,5 +103,5 @@ ownerGroup f (User owner) (Group group) = property (f ++ " owner " ++ og) $ do -- | Ensures that a file/dir has the specfied mode. mode :: FilePath -> FileMode -> Property NoInfo mode f v = property (f ++ " mode " ++ show v) $ do - liftIO $ modifyFileMode f (\_old -> v) + liftIO $ modifyFileMode f (const v) noChange diff --git a/src/Propellor/Shim.hs b/src/Propellor/Shim.hs index a3c8e701..e2941420 100644 --- a/src/Propellor/Shim.hs +++ b/src/Propellor/Shim.hs @@ -77,7 +77,7 @@ installFile :: FilePath -> FilePath -> IO () installFile top f = do createDirectoryIfMissing True destdir nukeFile dest - createLink f dest `catchIO` (const copy) + createLink f dest `catchIO` const copy where copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest] destdir = inTop top $ takeDirectory f diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index cce754ca..c5b31cef 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -59,7 +59,7 @@ spin target relay hst = do -- And now we can run it. unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $ - error $ "remote propellor failed" + error "remote propellor failed" where hn = fromMaybe target relay @@ -184,7 +184,7 @@ updateServer target relay hst connect haveprecompiled = let loop = go (toh, fromh) let restart = updateServer hn relay hst connect haveprecompiled let done = return () - v <- (maybe Nothing readish <$> getMarked fromh statusMarker) + v <- maybe Nothing readish <$> getMarked fromh statusMarker case v of (Just NeedRepoUrl) -> do sendRepoUrl toh @@ -263,7 +263,7 @@ sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do -- This should be reasonably portable, as long as the remote host has the -- same architecture as the build host. sendPrecompiled :: HostName -> IO () -sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor as a last resort") $ do +sendPrecompiled hn = void $ actionMessage "Uploading locally compiled propellor as a last resort" $ bracket getWorkingDirectory changeWorkingDirectory $ \_ -> withTmpDir "propellor" go where diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 1fc26892..ce93e144 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -219,7 +219,7 @@ class Combines x y where -- that ensures the first, and if the first succeeds, ensures the second. -- The property uses the description of the first property. before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x -before x y = (y `requires` x) `describe` (getDesc x) +before x y = (y `requires` x) `describe` getDesc x -- | Combines together two properties, yielding a property that -- has the description and info of the first, and that has the second diff --git a/src/Propellor/Types/Container.hs b/src/Propellor/Types/Container.hs index d21bada7..ecff5118 100644 --- a/src/Propellor/Types/Container.hs +++ b/src/Propellor/Types/Container.hs @@ -17,12 +17,12 @@ data Bound v = Bound -- For example, @Port 8080 -<- Port 80@ means that port 8080 on the host -- is bound to port 80 from the container. (-<-) :: (hostv ~ v, containerv ~ v) => hostv -> containerv -> Bound v -(-<-) hostv containerv = Bound hostv containerv +(-<-) = Bound -- | Flipped version of -<- with the container value first and host value -- second. (->-) :: (containerv ~ v, hostv ~ v) => hostv -> containerv -> Bound v -(->-) containerv hostv = Bound hostv containerv +(->-) = flip (-<-) -- | Create a Bound value, that is the same on both the host and container. same :: v -> Bound v -- cgit v1.2.3 From f256b24aa87409a599b388f0a7848aa9abecaa7f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 13 Sep 2015 13:35:12 -0400 Subject: avoid brackets --- src/Propellor/Property/Debootstrap.hs | 4 ++-- src/Propellor/Property/Docker.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index 74da68b4..2551d679 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -158,10 +158,10 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do let indexfile = tmpd "index.html" unlessM (download baseurl indexfile) $ errorMessage $ "Failed to download " ++ baseurl - urls <- (sortBy (flip compare) -- highest version first + urls <- sortBy (flip compare) -- highest version first . filter ("debootstrap_" `isInfixOf`) . filter (".tar." `isInfixOf`) - . extractUrls baseurl) <$> + . extractUrls baseurl <$> readFileStrictAnyEncoding indexfile nukeFile indexfile diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index fc12cf8c..8c70b714 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -630,8 +630,8 @@ data ContainerFilter = RunningContainers | AllContainers -- | Only lists propellor managed containers. listContainers :: ContainerFilter -> IO [ContainerId] listContainers status = - (mapMaybe toContainerId . concatMap (split ",") - . mapMaybe (lastMaybe . words) . lines) + mapMaybe toContainerId . concatMap (split ",") + . mapMaybe (lastMaybe . words) . lines <$> readProcess dockercmd ps where ps -- cgit v1.2.3 From 515f823c49e0eda9a07673bd938e36c33d9c1a80 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 13 Sep 2015 18:18:52 -0400 Subject: avoid running debconf-set-selections on [] and add some types for documentation --- src/Propellor/Property/Apt.hs | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index e89ea6a2..2e913540 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -239,18 +239,25 @@ unattendedUpgrades = enable disable ("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };") _ -> noChange +type DebconfTemplate = String +type DebconfTemplateType = String +type DebconfTemplateValue = String + -- | Preseeds debconf values and reconfigures the package so it takes -- effect. -reConfigure :: Package -> [(String, String, String)] -> Property NoInfo +reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property NoInfo reConfigure package vals = reconfigure `requires` setselections `describe` ("reconfigure " ++ package) where - setselections = property "preseed" $ makeChange $ - withHandle StdinHandle createProcessSuccess - (proc "debconf-set-selections" []) $ \h -> do - forM_ vals $ \(tmpl, tmpltype, value) -> - hPutStrLn h $ unwords [package, tmpl, tmpltype, value] - hClose h + setselections = property "preseed" $ + if null vals + then noChange + else makeChange $ + withHandle StdinHandle createProcessSuccess + (proc "debconf-set-selections" []) $ \h -> do + forM_ vals $ \(tmpl, tmpltype, value) -> + hPutStrLn h $ unwords [package, tmpl, tmpltype, value] + hClose h reconfigure = cmdPropertyEnv "dpkg-reconfigure" ["-fnone", package] noninteractiveEnv -- | Ensures that a service is installed and running. -- cgit v1.2.3 From 0457c70623a86c872bdbdc731d74c96c432bbb1c Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Mon, 14 Sep 2015 18:01:58 +0200 Subject: add Unbound property Signed-off-by: Félix Sipma --- propellor.cabal | 1 + src/Propellor/Property/Unbound.hs | 85 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 86 insertions(+) create mode 100644 src/Propellor/Property/Unbound.hs (limited to 'src/Propellor') diff --git a/propellor.cabal b/propellor.cabal index f30695a0..f3c6bacd 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -111,6 +111,7 @@ Library Propellor.Property.Systemd Propellor.Property.Systemd.Core Propellor.Property.Tor + Propellor.Property.Unbound Propellor.Property.User Propellor.Property.HostingProvider.CloudAtCost Propellor.Property.HostingProvider.DigitalOcean diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs new file mode 100644 index 00000000..6708bb69 --- /dev/null +++ b/src/Propellor/Property/Unbound.hs @@ -0,0 +1,85 @@ +module Propellor.Property.Unbound + ( installed + , restarted + , reloaded + , genAddressNoTtl + , genAddress + , genMX + , genPTR + , revIP + , canonical + , genZoneStatic + , genZoneTransparent +) where + +import Propellor +import qualified Propellor.Property.Apt as Apt + +import Data.List +import Data.String.Utils (split, replace) + + +installed :: Property NoInfo +installed = Apt.installed ["unbound"] + +restarted :: Property NoInfo +restarted = Service.restarted "unbound" + +reloaded :: Property NoInfo +reloaded = Service.reloaded "unbound" + +dValue :: BindDomain -> String +dValue (RelDomain d) = d +dValue (AbsDomain d) = d ++ "." +dValue (RootDomain) = "@" + +genAddressNoTtl :: BindDomain -> IPAddr -> String +genAddressNoTtl dom = genAddress dom Nothing + +genAddress :: BindDomain -> Maybe Int -> IPAddr -> String +genAddress dom ttl addr = case addr of + IPv4 _ -> genAddress' "A" dom ttl addr + IPv6 _ -> genAddress' "AAAA" dom ttl addr + +genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String +genAddress' recordtype dom ttl addr = localData $ dValue dom ++ " " ++ maybe "" (\ttl' -> show ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr + +genMX :: BindDomain -> BindDomain -> Int -> String +genMX dom dest priority = localData $ dValue dom ++ " " ++ "MX" ++ " " ++ show priority ++ " " ++ dValue dest + +genPTR :: BindDomain -> IPAddr -> String +genPTR dom ip = localData $ revIP ip ++ ". " ++ "PTR" ++ " " ++ dValue dom + +revIP :: IPAddr -> String +revIP addr = case addr of + IPv4 addr' -> intercalate "." (reverse $ split "." addr') ++ ".in-addr.arpa" + IPv6 _ -> reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonical addr) ++ ".ip6.arpa" + +canonical :: IPAddr -> IPAddr +canonical (IPv4 addr) = IPv4 addr +canonical (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":" $ replaceImplicitGroups addr + where + canonicalGroup g = case length g of + 0 -> "0000" + 1 -> "000" ++ g + 2 -> "00" ++ g + 3 -> "0" ++ g + _ -> g + emptyGroups n = iterate (++ ":") "" !! n + numberOfImplicitGroups a = 8 - length (split ":" $ replace "::" "" a) + replaceImplicitGroups a = concat $ aux $ split "::" a + where + aux [] = [] + aux (x : xs) = x : emptyGroups (numberOfImplicitGroups a) : xs + +localData :: String -> String +localData conf = " local-data: \"" ++ conf ++ "\"" + +genZoneStatic :: BindDomain -> String +genZoneStatic dom = localZone (dValue dom) "static" + +genZoneTransparent :: BindDomain -> String +genZoneTransparent dom = localZone (dValue dom) "transparent" + +localZone :: String -> String -> String +localZone zone confzone = " local-zone: \"" ++ zone ++ "\" " ++ confzone -- cgit v1.2.3 From 91cb7739968a687ca7922369b2271dc429dbdb9d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 14 Sep 2015 15:01:15 -0400 Subject: docs --- debian/changelog | 2 ++ src/Propellor/Property/Unbound.hs | 2 ++ 2 files changed, 4 insertions(+) (limited to 'src/Propellor') diff --git a/debian/changelog b/debian/changelog index 37a50ebd..ac36b583 100644 --- a/debian/changelog +++ b/debian/changelog @@ -11,6 +11,8 @@ propellor (2.8.0) UNRELEASED; urgency=medium * Added DebianMirror module, contributed by Félix Sipma. * Some hlint cleanups. Thanks, Mario Lang + * Added Propellor.Property.Unbound for the caching DNS server. + Thanks, Félix Sipma. -- Joey Hess Fri, 04 Sep 2015 10:36:40 -0700 diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs index 6708bb69..39691482 100644 --- a/src/Propellor/Property/Unbound.hs +++ b/src/Propellor/Property/Unbound.hs @@ -1,3 +1,5 @@ +-- | Properties for the Unbound caching DNS server + module Propellor.Property.Unbound ( installed , restarted -- cgit v1.2.3 From 115baccc7761356ec6633202e69dfff65f53a993 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 14 Sep 2015 15:03:42 -0400 Subject: add missing import and minor cleanup --- src/Propellor/Property/Unbound.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs index 39691482..950f669e 100644 --- a/src/Propellor/Property/Unbound.hs +++ b/src/Propellor/Property/Unbound.hs @@ -12,10 +12,11 @@ module Propellor.Property.Unbound , canonical , genZoneStatic , genZoneTransparent -) where + ) where import Propellor import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Service as Service import Data.List import Data.String.Utils (split, replace) @@ -53,9 +54,8 @@ genPTR :: BindDomain -> IPAddr -> String genPTR dom ip = localData $ revIP ip ++ ". " ++ "PTR" ++ " " ++ dValue dom revIP :: IPAddr -> String -revIP addr = case addr of - IPv4 addr' -> intercalate "." (reverse $ split "." addr') ++ ".in-addr.arpa" - IPv6 _ -> reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonical addr) ++ ".ip6.arpa" +revIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa" +revIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonical addr) ++ ".ip6.arpa" canonical :: IPAddr -> IPAddr canonical (IPv4 addr) = IPv4 addr -- cgit v1.2.3 From 9a0169f0cbdf2470e149a32f5fab8ec2369686f3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 14 Sep 2015 20:11:25 -0400 Subject: clean up privdata excess/lacking newline issue * PrivData converted to newtype (API change). * Stopped stripping trailing newlines when setting PrivData; this was previously done to avoid mistakes when pasting eg passwords with an unwanted newline. Instead, PrivData consumers should use either privDataLines or privDataVal, to extract respectively lines or a value (without internal newlines) from PrivData. --- debian/changelog | 6 ++++++ src/Propellor/PrivData.hs | 22 +++++++++---------- src/Propellor/Property/Docker.hs | 2 +- src/Propellor/Property/File.hs | 2 +- src/Propellor/Property/Gpg.hs | 2 +- .../Property/SiteSpecific/GitAnnexBuilder.hs | 7 +++--- src/Propellor/Property/SiteSpecific/IABak.hs | 2 +- src/Propellor/Property/Ssh.hs | 25 +++++++++++++++------- src/Propellor/Property/Tor.hs | 4 ++-- src/Propellor/Property/User.hs | 4 ++-- src/Propellor/Types/PrivData.hs | 21 +++++++++++++++++- 11 files changed, 66 insertions(+), 31 deletions(-) (limited to 'src/Propellor') diff --git a/debian/changelog b/debian/changelog index ac36b583..4029e5e7 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,12 @@ propellor (2.8.0) UNRELEASED; urgency=medium Thanks, Mario Lang * Added Propellor.Property.Unbound for the caching DNS server. Thanks, Félix Sipma. + * PrivData converted to newtype (API change). + * Stopped stripping trailing newlines when setting PrivData; + this was previously done to avoid mistakes when pasting eg passwords + with an unwanted newline. Instead, PrivData consumers should use either + privDataLines or privDataVal, to extract respectively lines or a + value (without internal newlines) from PrivData. -- Joey Hess Fri, 04 Sep 2015 10:36:40 -0700 diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index cbb296ce..b7932518 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -132,7 +132,7 @@ getLocalPrivData field context = where localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal -type PrivMap = M.Map (PrivDataField, Context) PrivData +type PrivMap = M.Map (PrivDataField, Context) String -- | Get only the set of PrivData that the Host's Info says it uses. filterPrivData :: Host -> PrivMap -> PrivMap @@ -142,12 +142,14 @@ filterPrivData host = M.filterWithKey (\k _v -> S.member k used) fromPrivInfo $ getInfo $ hostInfo host getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData -getPrivData field context = M.lookup (field, context) +getPrivData field context m = do + s <- M.lookup (field, context) m + return (PrivData s) setPrivData :: PrivDataField -> Context -> IO () setPrivData field context = do putStrLn "Enter private data on stdin; ctrl-D when done:" - setPrivDataTo field context =<< hGetContentsStrict stdin + setPrivDataTo field context . PrivData =<< hGetContentsStrict stdin unsetPrivData :: PrivDataField -> Context -> IO () unsetPrivData field context = do @@ -156,7 +158,8 @@ unsetPrivData field context = do dumpPrivData :: PrivDataField -> Context -> IO () dumpPrivData field context = - maybe (error "Requested privdata is not set.") putStrLn + maybe (error "Requested privdata is not set.") + (mapM_ putStrLn . privDataLines) =<< (getPrivData field context <$> decryptPrivData) editPrivData :: PrivDataField -> Context -> IO () @@ -164,11 +167,11 @@ editPrivData field context = do v <- getPrivData field context <$> decryptPrivData v' <- withTmpFile "propellorXXXX" $ \f h -> do hClose h - maybe noop (writeFileProtected f) v + maybe noop (writeFileProtected f . unlines . privDataLines) v editor <- getEnvDefault "EDITOR" "vi" unlessM (boolSystem editor [File f]) $ error "Editor failed; aborting." - readFile f + PrivData <$> readFile f setPrivDataTo field context v' listPrivDataFields :: [Host] -> IO () @@ -202,14 +205,11 @@ listPrivDataFields hosts = do putStr $ unlines $ formatTable $ tableWithHeader header rows setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO () -setPrivDataTo field context value = do +setPrivDataTo field context (PrivData value) = do modifyPrivData set putStrLn "Private data set." where - set = M.insert (field, context) (chomp value) - chomp s - | end s == "\n" = chomp (beginning s) - | otherwise = s + set = M.insert (field, context) value modifyPrivData :: (PrivMap -> PrivMap) -> IO () modifyPrivData f = do diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 8c70b714..9cfc24b6 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -75,7 +75,7 @@ configured = prop `requires` installed where prop = withPrivData src anyContext $ \getcfg -> property "docker configured" $ getcfg $ \cfg -> ensureProperty $ - "/root/.dockercfg" `File.hasContent` (lines cfg) + "/root/.dockercfg" `File.hasContent` privDataLines cfg src = PrivDataSourceFileFromCommand DockerAuthentication "/root/.dockercfg" "docker login" diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 4e074eee..4563fe79 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -40,7 +40,7 @@ hasPrivContent' writer source f context = withPrivData source context $ \getcontent -> property desc $ getcontent $ \privcontent -> ensureProperty $ fileProperty' writer desc - (\_oldcontent -> lines privcontent) f + (\_oldcontent -> privDataLines privcontent) f where desc = "privcontent " ++ f diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs index 0f68f8fe..e57749ae 100644 --- a/src/Propellor/Property/Gpg.hs +++ b/src/Propellor/Property/Gpg.hs @@ -33,7 +33,7 @@ keyImported (GpgKeyId keyid) user@(User u) = flagFile' prop genflag withHandle StdinHandle createProcessSuccess (proc "su" ["-c", "gpg --import", u]) $ \h -> do fileEncoding h - hPutStr h key + hPutStr h (unlines (privDataLines key)) hClose h src = PrivDataSource GpgKey "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a" diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 6a6d5bfd..bd8b1ff3 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -39,10 +39,11 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props -- password used to upload the built image. rsyncpassword = withPrivData (Password builduser) context $ \getpw -> property "rsync password" $ getpw $ \pw -> do - oldpw <- liftIO $ catchDefaultIO "" $ + have <- liftIO $ catchDefaultIO "" $ readFileStrict pwfile - if pw /= oldpw - then makeChange $ writeFile pwfile pw + let want = privDataVal pw + if want /= have + then makeChange $ writeFile pwfile want else noChange tree :: Architecture -> Property HasInfo diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs index 8c9926bc..68313f20 100644 --- a/src/Propellor/Property/SiteSpecific/IABak.hs +++ b/src/Propellor/Property/SiteSpecific/IABak.hs @@ -103,4 +103,4 @@ graphiteServer = propertyList "iabak graphite server" $ props graphiteCSRF = withPrivData (Password "csrf-token") (Context "iabak.archiveteam.org") $ \gettoken -> property "graphite-web CSRF token" $ gettoken $ \token -> ensureProperty $ File.containsLine - "/etc/graphite/local_settings.py" ("SECRET_KEY = '"++ token ++"'") + "/etc/graphite/local_settings.py" ("SECRET_KEY = '"++ privDataVal token ++"'") diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 5f0082cb..fbd57057 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -147,22 +147,29 @@ hostKeys ctx l = propertyList desc $ catMaybes $ hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property HasInfo hostKey context keytype pub = combineProperties desc [ pubKey keytype pub - , toProp $ property desc $ install writeFile True pub + , toProp $ property desc $ install writeFile True (lines pub) , withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey -> - property desc $ getkey $ install writeFileProtected False + property desc $ getkey $ + install writeFileProtected False . privDataLines ] `onChange` restarted where desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")" - install writer ispub key = do + install writer ispub keylines = do let f = keyFile keytype ispub - s <- liftIO $ catchDefaultIO "" $ readFileStrict f - if s == key + have <- liftIO $ catchDefaultIO "" $ readFileStrict f + let want = keyFileContent keylines + if have == want then noChange - else makeChange $ writer f key + else makeChange $ writer f want keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext) ("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey") +-- Make sure that there is a newline at the end; +-- ssh requires this for some types of private keys. +keyFileContent :: [String] -> String +keyFileContent keylines = unlines (keylines ++ [""]) + keyFile :: SshKeyType -> Bool -> FilePath keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext where @@ -221,7 +228,7 @@ keyImported' dest keytype user@(User u) context = combineProperties desc , ensureProperties [ property desc $ makeChange $ do createDirectoryIfMissing True (takeDirectory f) - writer f key + writer f (keyFileContent (privDataLines key)) , File.ownerGroup f user (userGroup user) , File.ownerGroup (takeDirectory f) user (userGroup user) ] @@ -232,6 +239,8 @@ keyImported' dest keytype user@(User u) context = combineProperties desc return $ home ".ssh" "id_" ++ fromKeyType keytype ++ ext Just f -> return $ f ++ ext + + fromKeyType :: SshKeyType -> String fromKeyType SshRsa = "rsa" fromKeyType SshDsa = "dsa" @@ -267,7 +276,7 @@ authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) contex f <- liftIO $ dotFile "authorized_keys" user liftIO $ do createDirectoryIfMissing True (takeDirectory f) - writeFileProtected f v + writeFileProtected f (keyFileContent (privDataLines v)) ensureProperties [ File.ownerGroup f user (userGroup user) , File.ownerGroup (takeDirectory f) user (userGroup user) diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs index 535da951..e2ee3dad 100644 --- a/src/Propellor/Property/Tor.hs +++ b/src/Propellor/Property/Tor.hs @@ -134,12 +134,12 @@ hiddenServiceData hn context = combineProperties desc desc = unwords ["hidden service data available in", varLib hn] installonion f = withPrivData (PrivFile $ varLib hn f) context $ \getcontent -> property desc $ getcontent $ install $ varLib hn f - install f content = ifM (liftIO $ doesFileExist f) + install f privcontent = ifM (liftIO $ doesFileExist f) ( noChange , ensureProperties [ property desc $ makeChange $ do createDirectoryIfMissing True (takeDirectory f) - writeFileProtected f content + writeFileProtected f (unlines (privDataLines privcontent)) , File.mode (takeDirectory f) $ combineModes [ownerReadMode, ownerWriteMode, ownerExecuteMode] , File.ownerGroup (takeDirectory f) user (userGroup user) diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs index add3ae52..c029999f 100644 --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -58,8 +58,8 @@ hasPassword' (User u) context = go `requires` shadowConfig True setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result setPassword getpassword = getpassword $ go where - go (Password user, password) = set user password [] - go (CryptPassword user, hash) = set user hash ["--encrypted"] + go (Password user, password) = set user (privDataVal password) [] + go (CryptPassword user, hash) = set user (privDataVal hash) ["--encrypted"] go (f, _) = error $ "Unexpected type of privdata: " ++ show f set user v ps = makeChange $ withHandle StdinHandle createProcessSuccess diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs index d713c7cf..c72838cb 100644 --- a/src/Propellor/Types/PrivData.hs +++ b/src/Propellor/Types/PrivData.hs @@ -1,6 +1,9 @@ module Propellor.Types.PrivData where import Propellor.Types.OS +import Utility.PartialPrelude + +import Data.Maybe -- | Note that removing or changing constructors or changing types will -- break the serialized privdata files, so don't do that! @@ -89,7 +92,23 @@ anyContext = Context "any" hostContext :: HostContext hostContext = HostContext Context -type PrivData = String +-- | Contains the actual private data. +-- +-- Note that this may contain exta newlines at the end, or they may have +-- been stripped off, depending on how the user entered the privdata, +-- and which version of propellor stored it. Use the accessor functions +-- below to avoid newline problems. +newtype PrivData = PrivData String + +-- | When PrivData is the content of a file, this is the lines thereof. +privDataLines :: PrivData -> [String] +privDataLines (PrivData s) = lines s + +-- | When the PrivData is a single value, like a password, this extracts +-- it. Note that if multiple lines are present in the PrivData, only +-- the first is returned; there is never a newline in the String. +privDataVal :: PrivData -> String +privDataVal (PrivData s) = fromMaybe "" (headMaybe (lines s)) data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519 deriving (Read, Show, Ord, Eq, Enum, Bounded) -- cgit v1.2.3