From c282a894b56012ae4f68b518e5fad01052ac4f22 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 5 Jul 2017 16:01:55 -0400 Subject: XFCE and applyPath properties * Propellor.Property.XFCE added with some useful properties for the desktop environment. * Added File.applyPath property. This commit was sponsored by Riku Voipio. --- src/Propellor/Property/File.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property/File.hs') diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 459fe2c7..fcfcade1 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} module Propellor.Property.File where @@ -177,6 +177,20 @@ ownerGroup f (User owner) (Group group) = p `describe` (f ++ " owner " ++ og) `changesFile` f og = owner ++ ":" ++ group +-- | Given a base directory, and a relative path under that +-- directory, applies a property to each component of the path in turn, +-- starting with the base directory. +-- +-- For example, to make a file owned by a user, making sure their home +-- directory and the subdirectories to it are also owned by them: +-- +-- > "/home/user/program/file" `hasContent` ["foo"] +-- > `before` applyPath "/home/user" ".config/program/file" +-- > (\f -> ownerGroup f (User "user") (Group "user")) +applyPath :: Monoid (Property metatypes) => FilePath -> FilePath -> (FilePath -> Property metatypes) -> Property metatypes +applyPath basedir relpath mkp = mconcat $ + map mkp (scanl () basedir (splitPath relpath)) + -- | Ensures that a file/dir has the specfied mode. mode :: FilePath -> FileMode -> Property UnixLike mode f v = p `changesFile` f -- cgit v1.3-2-g0d8e From 60db0d5761254f5074a5d312ebb498bf031379a5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 5 Jul 2017 16:38:16 -0400 Subject: rename confusing f' to src f' normally means a later version of f --- src/Propellor/Property/File.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'src/Propellor/Property/File.hs') diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index fcfcade1..b1e72989 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -105,11 +105,11 @@ hasPrivContent' writemode source f context = -- | Replaces the content of a file with the transformed content of another file basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike -f `basedOn` (f', a) = property' desc $ \o -> do - tmpl <- liftIO $ readFile f' +f `basedOn` (src, a) = property' desc $ \o -> do + tmpl <- liftIO $ readFile src ensureProperty o $ fileProperty desc (\_ -> a $ lines $ tmpl) f where - desc = f ++ " is based on " ++ f' + desc = f ++ " is based on " ++ src -- | Removes a file. Does not remove symlinks or non-plain-files. notPresent :: FilePath -> Property UnixLike @@ -150,23 +150,23 @@ link `isSymlinkedTo` (LinkTarget target) = property desc $ -- | Ensures that a file is a copy of another (regular) file. isCopyOf :: FilePath -> FilePath -> Property UnixLike -f `isCopyOf` f' = property desc $ go =<< (liftIO $ tryIO $ getFileStatus f') +f `isCopyOf` src = property desc $ go =<< (liftIO $ tryIO $ getFileStatus src) where - desc = f ++ " is copy of " ++ f' + desc = f ++ " is copy of " ++ src go (Right stat) = if isRegularFile stat then gocmp =<< (liftIO $ cmp) - else warningMessage (f' ++ " is not a regular file") >> + else warningMessage (src ++ " is not a regular file") >> return FailedChange go (Left e) = warningMessage (show e) >> return FailedChange - cmp = safeSystem "cmp" [Param "-s", Param "--", File f, File f'] + cmp = safeSystem "cmp" [Param "-s", Param "--", File f, File src] gocmp ExitSuccess = noChange gocmp (ExitFailure 1) = doit gocmp _ = warningMessage "cmp failed" >> return FailedChange - doit = makeChange $ copy f' `viaStableTmp` f - copy src dest = unlessM (runcp src dest) $ errorMessage "cp failed" - runcp src dest = boolSystem "cp" + doit = makeChange $ copy `viaStableTmp` f + copy dest = unlessM (runcp dest) $ errorMessage "cp failed" + runcp dest = boolSystem "cp" [Param "--preserve=all", Param "--", File src, File dest] -- | Ensures that a file/dir has the specified owner and group. -- cgit v1.3-2-g0d8e From 256c5c3c572e56d3755914e40cfd9dfd94112bbb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 5 Jul 2017 16:47:12 -0400 Subject: File.isCopyOf: Fix bug that prevented this property from working when the destination file did not yet exist. This commit was sponsored by andrea rota. --- debian/changelog | 2 ++ src/Propellor/Property/File.hs | 5 ++++- 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property/File.hs') diff --git a/debian/changelog b/debian/changelog index e92a24e1..7917bbf6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -21,6 +21,8 @@ propellor (4.1.0) UNRELEASED; urgency=medium * Propellor.Property.XFCE added with some useful properties for the desktop environment. * Added File.applyPath property. + * File.isCopyOf: Fix bug that prevented this property from working + when the destination file did not yet exist. -- Joey Hess Tue, 20 Jun 2017 10:55:37 -0400 diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index b1e72989..8d10b94c 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -154,7 +154,10 @@ f `isCopyOf` src = property desc $ go =<< (liftIO $ tryIO $ getFileStatus src) where desc = f ++ " is copy of " ++ src go (Right stat) = if isRegularFile stat - then gocmp =<< (liftIO $ cmp) + then ifM (liftIO $ doesFileExist f) + ( gocmp =<< (liftIO $ cmp) + , doit + ) else warningMessage (src ++ " is not a regular file") >> return FailedChange go (Left e) = warningMessage (show e) >> return FailedChange -- cgit v1.3-2-g0d8e From 0d15c3f01a424e021481c9630441997c032cbc82 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 5 Jul 2017 16:57:03 -0400 Subject: Added File.checkOverwrite. This commit was sponsored by Ethan Aubin. --- debian/changelog | 1 + joeyconfig.hs | 2 +- src/Propellor/Property/File.hs | 9 +++++++++ src/Propellor/Property/XFCE.hs | 20 +++++++------------- 4 files changed, 18 insertions(+), 14 deletions(-) (limited to 'src/Propellor/Property/File.hs') diff --git a/debian/changelog b/debian/changelog index 7917bbf6..ea9f43bf 100644 --- a/debian/changelog +++ b/debian/changelog @@ -21,6 +21,7 @@ propellor (4.1.0) UNRELEASED; urgency=medium * Propellor.Property.XFCE added with some useful properties for the desktop environment. * Added File.applyPath property. + * Added File.checkOverwrite. * File.isCopyOf: Fix bug that prevented this property from working when the destination file did not yet exist. diff --git a/joeyconfig.hs b/joeyconfig.hs index 20e73cef..4286097b 100644 --- a/joeyconfig.hs +++ b/joeyconfig.hs @@ -118,7 +118,7 @@ demo = host "demo" $ props & root `User.hasInsecurePassword` "debian" & user `User.hasInsecurePassword` "debian" & XFCE.installedMin - & XFCE.defaultPanelFor user OverwriteExisting + & XFCE.defaultPanelFor user File.OverwriteExisting & LightDM.autoLogin user & Apt.installed ["firefox"] where diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 8d10b94c..3293599a 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -307,3 +307,12 @@ readConfigFileName = readish . unescape Nothing -> '_' : ns ++ unescape cs' Just n -> chr n : unescape cs' unescape (c:cs) = c : unescape cs + +data Overwrite = OverwriteExisting | PreserveExisting + +-- | When passed PreserveExisting, only ensures the property when the file +-- does not exist. +checkOverwrite :: Overwrite -> FilePath -> (FilePath -> Property i) -> Property i +checkOverwrite OverwriteExisting f mkp = mkp f +checkOverwrite PreserveExisting f mkp = + check (not <$> doesFileExist f) (mkp f) diff --git a/src/Propellor/Property/XFCE.hs b/src/Propellor/Property/XFCE.hs index e0c062ae..6241326e 100644 --- a/src/Propellor/Property/XFCE.hs +++ b/src/Propellor/Property/XFCE.hs @@ -15,11 +15,9 @@ installedMin :: Property DebianLike installedMin = Apt.installedMin ["xfce4", "xfce4-terminal", "task-desktop"] `describe` "minimal XFCE desktop installed" -data Overwrite = OverwriteExisting | PreserveExisting - -- | Normally at first login, XFCE asks what kind of panel the user wants. -- This enables the default configuration noninteractively. -defaultPanelFor :: User -> Overwrite -> Property DebianLike +defaultPanelFor :: User -> File.Overwrite -> Property DebianLike defaultPanelFor u@(User username) overwrite = property' desc $ \w -> do home <- liftIO $ User.homedir u ensureProperty w (go home) @@ -30,13 +28,9 @@ defaultPanelFor u@(User username) overwrite = property' desc $ \w -> do -- This location is probably Debian-specific. defcf = "/etc/xdg/xfce4/panel/default.xml" go :: FilePath -> Property DebianLike - go home = tightenTargets $ checkoverwrite cf - cf `File.isCopyOf` defcf - `before` File.applyPath home basecf - (\f -> File.ownerGroup f u (userGroup u)) - `requires` Apt.installed ["xfce4-panel"] - where - cf = home basecf - checkoverwrite cf p = case overwrite of - OverwriteExisting -> p - PreserveExisting -> check (not <$> doesFileExist cf) p + go home = tightenTargets $ + File.checkOverwrite overwrite (home basecf) $ \cf -> + cf `File.isCopyOf` defcf + `before` File.applyPath home basecf + (\f -> File.ownerGroup f u (userGroup u)) + `requires` Apt.installed ["xfce4-panel"] -- cgit v1.3-2-g0d8e