summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2017-07-05 16:01:55 -0400
committerJoey Hess2017-07-05 16:01:55 -0400
commitc282a894b56012ae4f68b518e5fad01052ac4f22 (patch)
treeda7e10201ef684efffefd8e10e59278fca3b565f
parent4cbaa3ac665786fb0be4aa3121c6e6c447142d24 (diff)
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.
-rw-r--r--debian/changelog3
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Property.hs1
-rw-r--r--src/Propellor/Property/DiskImage.hs6
-rw-r--r--src/Propellor/Property/File.hs16
-rw-r--r--src/Propellor/Property/XFCE.hs38
6 files changed, 63 insertions, 2 deletions
diff --git a/debian/changelog b/debian/changelog
index 743667a5..e92a24e1 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -18,6 +18,9 @@ propellor (4.1.0) UNRELEASED; urgency=medium
process was done; now output will be displayed immediately.
* LightDM.autoLogin: Make it require LightDM.installed.
(minor API change as the type changed)
+ * Propellor.Property.XFCE added with some useful properties for the
+ desktop environment.
+ * Added File.applyPath property.
-- Joey Hess <id@joeyh.name> Tue, 20 Jun 2017 10:55:37 -0400
diff --git a/propellor.cabal b/propellor.cabal
index abf5f05b..76646fb4 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -153,6 +153,7 @@ Library
Propellor.Property.Unbound
Propellor.Property.User
Propellor.Property.Uwsgi
+ Propellor.Property.XFCE
Propellor.Property.ZFS
Propellor.Property.ZFS.Process
Propellor.Property.ZFS.Properties
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 8b2a4e3d..55e688ab 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -50,6 +50,7 @@ import Data.Monoid
import Control.Monad.IfElse
import "mtl" Control.Monad.RWS.Strict
import System.Posix.Files
+import Data.Maybe
import Data.List
import Data.Hashable
import Control.Applicative
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index d5898d7c..89a8d0c6 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -49,7 +49,11 @@ type DiskImage = FilePath
-- First the specified Chroot is set up, and its properties are satisfied.
--
-- Then, the disk image is set up, and the chroot is copied into the
--- appropriate partition(s) of it.
+-- appropriate partition(s) of it.
+--
+-- The partitions default to being sized just large enough to fit the files
+-- from the chroot. You can use `addFreeSpace` to make them a bit larger
+-- than that, or `setSize` to use a fixed size.
--
-- Note that the disk image file is reused if it already exists,
-- to avoid expensive IO to generate a new one. And, it's updated in-place,
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
diff --git a/src/Propellor/Property/XFCE.hs b/src/Propellor/Property/XFCE.hs
new file mode 100644
index 00000000..e75946a5
--- /dev/null
+++ b/src/Propellor/Property/XFCE.hs
@@ -0,0 +1,38 @@
+module Propellor.Property.XFCE where
+
+import Propellor.Base
+import Propellor.Types.Core (getSatisfy)
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.User as User
+
+installed :: Property DebianLike
+installed = Apt.installed ["task-xfce-desktop"]
+
+-- | Minimal install of XFCE, with a terminal emulator and panel,
+-- and X, but not any of the extras.
+installedMin :: Property DebianLike
+installedMin = Apt.installedMin ["xfce4", "xfce4-terminal", "task-desktop"]
+
+-- | Normally at first login, XFCE asks what kind of panel the user wants.
+-- This enables the default configuration noninteractively.
+--
+-- If the user subsequently modifies their panel, their modifications will
+-- not be overwritten by this property.
+defaultPanelFor :: User -> Property DebianLike
+defaultPanelFor u@(User username) = adjustPropertySatisfy baseprop $ \s -> do
+ home <- liftIO $ User.homedir u
+ s <> fromMaybe mempty (getSatisfy (go home))
+ where
+ cf = ".config" </> "xfce4" </> "xfconf"
+ </> "xfce-perchannel-xml" </> "xfce4-panel.xml"
+ -- This location is probably Debian-specific.
+ defcf = "/etc/xdg/xfce4/panel/default.xml"
+ go :: FilePath -> Property DebianLike
+ go home = tightenTargets $
+ (home </> cf) `File.isCopyOf` defcf
+ `before` File.applyPath home cf
+ (\f -> File.ownerGroup f u (userGroup u))
+ `requires` Apt.installed ["xfce4-panel"]
+ baseprop :: Property DebianLike
+ baseprop = doNothing `describe` ("default XFCE panel for " ++ username)