summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog7
-rw-r--r--doc/forum/Bug_with_Sbuild/comment_2_3ca5ceb0ac97451c1eea00ec72b55896._comment9
-rw-r--r--doc/forum/Bug_with_Sbuild/comment_3_59b5bafd51d1255c4ab79e468afcca1c._comment13
-rw-r--r--doc/forum/use_withUmask_in_a_property/comment_1_593c3e8b1499b4cc9cc7db74bb775506._comment38
-rw-r--r--doc/forum/use_withUmask_in_a_property/comment_2_edefd952bdb96c8a6a5d705170a05a77._comment20
-rw-r--r--doc/forum/use_withUmask_in_a_property/comment_3_5bdd79ed99f2b001d5dfc8a7d0b2c177._comment18
-rw-r--r--doc/todo/bytes_in_privData__63__.mdwn2
-rw-r--r--doc/todo/bytes_in_privData__63__/comment_12_a4edd5e06854a4b37eeb6b3db5c01947._comment8
-rw-r--r--doc/todo/integrate_shell-monad/comment_6_d0328983a68958a914bd9fc9fe5a3abe._comment (renamed from doc/todo/integrate_shell-monad/comment_6_d0328983a68958a914bd9fc9fe5a3abe/comment_1_f42f2893433c312821d8d47f84cb5c43._comment)0
-rw-r--r--doc/todo/merge_request:_Firejail.hs.mdwn16
-rw-r--r--doc/todo/merge_request:_changes_to_Reboot.hs/comment_8_b4b2bd5741fbc7759d85d826dc1f9f7f._comment11
-rw-r--r--doc/todo/merge_request:_changes_to_Reboot.hs/comment_9_233140189ee7ffebad687db76dfe2258._comment22
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Exception.hs13
-rw-r--r--src/Propellor/Property.hs16
-rw-r--r--src/Propellor/Property/ConfFile.hs17
-rw-r--r--src/Propellor/Property/File.hs120
-rw-r--r--src/Propellor/Property/Firejail.hs31
-rw-r--r--src/Propellor/Types/Exception.hs5
-rw-r--r--src/Utility/Exception.hs8
20 files changed, 309 insertions, 66 deletions
diff --git a/debian/changelog b/debian/changelog
index 7cc3838e..be668ea5 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -28,6 +28,13 @@ propellor (3.1.0) UNRELEASED; urgency=medium
Thanks, Félix Sipma.
* Apt.install: When asked to install a package that apt does not know
about, it used to incorrectly succeed. Now it will fail.
+ * Property.Firejail: New module.
+ Thanks, Sean Whitton
+ * File: Write privdata files in binary rather than text, which avoids
+ failure when they do not contain valid unicode.
+ Thanks, Andrew Schurman
+ * Generalized fileProperty can now operate on a file as either a series
+ of lines, or a ByteString.
-- Joey Hess <id@joeyh.name> Fri, 10 Jun 2016 14:59:44 -0400
diff --git a/doc/forum/Bug_with_Sbuild/comment_2_3ca5ceb0ac97451c1eea00ec72b55896._comment b/doc/forum/Bug_with_Sbuild/comment_2_3ca5ceb0ac97451c1eea00ec72b55896._comment
new file mode 100644
index 00000000..c2b34090
--- /dev/null
+++ b/doc/forum/Bug_with_Sbuild/comment_2_3ca5ceb0ac97451c1eea00ec72b55896._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 2"
+ date="2016-06-19T07:19:33Z"
+ content="""
+Thank you for reporting this and for finding the fix, Fred. In a branch I'll be submitting soon I have modified `Ccache.hasCache` to chmod setgid the cache root, and this should propagate to all newly created subdirectories.
+
+Joey: what do you think about adding `cmdProperty \"chmod\" [\"-R\", \"g+s\" \"/var/cache/ccache-foo\"]` to `Ccache.hasCache` to fix existing broken setups? In my view it would be better to just add a note to the changelog suggesting this fix, but I'm not sure what you think would be best.
+"""]]
diff --git a/doc/forum/Bug_with_Sbuild/comment_3_59b5bafd51d1255c4ab79e468afcca1c._comment b/doc/forum/Bug_with_Sbuild/comment_3_59b5bafd51d1255c4ab79e468afcca1c._comment
new file mode 100644
index 00000000..fc12b9fe
--- /dev/null
+++ b/doc/forum/Bug_with_Sbuild/comment_3_59b5bafd51d1255c4ab79e468afcca1c._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2016-06-20T17:53:24Z"
+ content="""
+I generally try to fix up after bugs in the implementation of properties,
+because otherwise maintaining my hosts gets problimatic.
+
+In this case, the sbuild support is pretty new and probably not much
+used, so I guess it's up to you. chmod -R is rather expensive. If there's
+a cheap way to detect when that's needed and only run it then, that
+would be ideal..
+"""]]
diff --git a/doc/forum/use_withUmask_in_a_property/comment_1_593c3e8b1499b4cc9cc7db74bb775506._comment b/doc/forum/use_withUmask_in_a_property/comment_1_593c3e8b1499b4cc9cc7db74bb775506._comment
new file mode 100644
index 00000000..d52b4786
--- /dev/null
+++ b/doc/forum/use_withUmask_in_a_property/comment_1_593c3e8b1499b4cc9cc7db74bb775506._comment
@@ -0,0 +1,38 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-06-20T18:04:27Z"
+ content="""
+ withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
+
+That needs a monad, and propellor Property is not a monad itself.
+But, a Property does contain an Propellor monad action, which is run to ensure
+that the property is met. You can use withUmask inside that action.
+
+The problem then becomes, how to run a Property like
+your `cmdProperty` inside the Propellor monad?
+
+The answer is, using `ensureProperty`.
+[Documentation](http://hackage.haskell.org/package/propellor/docs/Propellor-EnsureProperty.html)
+
+Something like this is what you're looking for:
+
+ foo = Property UnixLike
+ foo = property' "generate new key file" $ \w ->
+ withUmask filemode $
+ ensureProperty w genrsa
+ where
+ filemode = -- something
+
+ genrsa :: Property UnixLike
+ genrsa = cmdProperty "openssl"
+ [ "genrsa"
+ , "4096"
+ , "> " ++ key
+ ]
+ `assume` MadeChange
+
+Incidentially, cmdProperty runs a command without exposing it to the
+shell, so I don't think the redirection in your example will work.
+You probably want to use scriptProperty instead.
+"""]]
diff --git a/doc/forum/use_withUmask_in_a_property/comment_2_edefd952bdb96c8a6a5d705170a05a77._comment b/doc/forum/use_withUmask_in_a_property/comment_2_edefd952bdb96c8a6a5d705170a05a77._comment
new file mode 100644
index 00000000..a569d068
--- /dev/null
+++ b/doc/forum/use_withUmask_in_a_property/comment_2_edefd952bdb96c8a6a5d705170a05a77._comment
@@ -0,0 +1,20 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-06-20T18:36:07Z"
+ content="""
+Here's another, perhaps simpler way to do it. The `adjustPropertySatisfy`
+function takes an existing Property and applies a function to the Propellor
+action inside it.
+
+ adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
+
+So, given the `genrsa` Property from my example above, you could
+modify its action to use withUmask:
+
+ adjustPropertySatisfy genrsa (withUmask filemode)
+
+This is simpler, but less flexible since it causes the entire
+Propellor action to be run with the specified umask, not just part of the
+action. But it works well for your purpose I think.
+"""]]
diff --git a/doc/forum/use_withUmask_in_a_property/comment_3_5bdd79ed99f2b001d5dfc8a7d0b2c177._comment b/doc/forum/use_withUmask_in_a_property/comment_3_5bdd79ed99f2b001d5dfc8a7d0b2c177._comment
new file mode 100644
index 00000000..3a9f89c2
--- /dev/null
+++ b/doc/forum/use_withUmask_in_a_property/comment_3_5bdd79ed99f2b001d5dfc8a7d0b2c177._comment
@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 3"
+ date="2016-06-20T18:49:30Z"
+ content="""
+Thanks!
+
+By reading Cmd.hs, I've managed to get this:
+
+ createKey :: FilePath -> Property UnixLike
+ createKey key = property (\"new private key file: \" ++ key) $ liftIO $ withUmask 0o0177 $ withFile key WriteMode $ \h ->
+ cmdResult <$> boolSystem' \"openssl\" [Param \"genrsa\", Param \"4096\"] (\p -> p { std_out = UseHandle h })
+
+ cmdResult :: Bool -> Result
+ cmdResult False = FailedChange
+ cmdResult True = NoChange
+
+"""]]
diff --git a/doc/todo/bytes_in_privData__63__.mdwn b/doc/todo/bytes_in_privData__63__.mdwn
index 27297fd5..66e3b1c2 100644
--- a/doc/todo/bytes_in_privData__63__.mdwn
+++ b/doc/todo/bytes_in_privData__63__.mdwn
@@ -15,3 +15,5 @@ It seems like I can't set the content of a PrivFile to arbitrary bytes.
Enter private data on stdin; ctrl-D when done:
propellor: <stdin>: hGetContents: invalid argument (invalid byte sequence)
+
+> [[done]]! --[[Joey]]
diff --git a/doc/todo/bytes_in_privData__63__/comment_12_a4edd5e06854a4b37eeb6b3db5c01947._comment b/doc/todo/bytes_in_privData__63__/comment_12_a4edd5e06854a4b37eeb6b3db5c01947._comment
new file mode 100644
index 00000000..1d645d09
--- /dev/null
+++ b/doc/todo/bytes_in_privData__63__/comment_12_a4edd5e06854a4b37eeb6b3db5c01947._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 12"""
+ date="2016-06-19T17:53:17Z"
+ content="""
+I found a reasonable way to refactor it without the duplication, so have
+landed the patch.
+"""]]
diff --git a/doc/todo/integrate_shell-monad/comment_6_d0328983a68958a914bd9fc9fe5a3abe/comment_1_f42f2893433c312821d8d47f84cb5c43._comment b/doc/todo/integrate_shell-monad/comment_6_d0328983a68958a914bd9fc9fe5a3abe._comment
index 8ba13e99..8ba13e99 100644
--- a/doc/todo/integrate_shell-monad/comment_6_d0328983a68958a914bd9fc9fe5a3abe/comment_1_f42f2893433c312821d8d47f84cb5c43._comment
+++ b/doc/todo/integrate_shell-monad/comment_6_d0328983a68958a914bd9fc9fe5a3abe._comment
diff --git a/doc/todo/merge_request:_Firejail.hs.mdwn b/doc/todo/merge_request:_Firejail.hs.mdwn
new file mode 100644
index 00000000..b593c5b4
--- /dev/null
+++ b/doc/todo/merge_request:_Firejail.hs.mdwn
@@ -0,0 +1,16 @@
+Please consider merging branch `firejail` of repo `https://git.spwhitton.name/propellor`.
+
+Changes:
+
+- Add `applytoList` property combinator
+- Add `Propellor.Property.Firejail` module
+
+Comments:
+
+- I'm not sure whether Joey or I originally wrote `applyToList`; it's been in my config.hs for a while
+- `Firejail.jailed` accepts a list of executables (and `Firejail.jailed'` is not exported) because as with `Apt.installed`, I think most users will want to jail more than one program. For example `Firejail.jailed ["firefox", "evince"]`.
+- I made the build clean on GHC 7.10 but there is a warning on 7.6 that `Prelude` does not export `Foldable`. I don't know how to fix this while maintaining the 7.10 clean build, and it seems to me that having the 7.10 build be clean is more important than having the 7.6 build be clean.
+
+--spwhitton
+
+> [[done]], thanks! (I fixed the warning.) --[[Joey]]
diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_8_b4b2bd5741fbc7759d85d826dc1f9f7f._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_8_b4b2bd5741fbc7759d85d826dc1f9f7f._comment
new file mode 100644
index 00000000..36556924
--- /dev/null
+++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_8_b4b2bd5741fbc7759d85d826dc1f9f7f._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 8"
+ date="2016-06-19T12:31:40Z"
+ content="""
+Please consider merging my new `reboot` branch which addresses the discussion we've had.
+
+I also included some other improvements to `Sbuild.hs`, a bug fix in `Ccache.hs` and some GHC 7.6 compatibility fixes. With one exception,[1] I think that the changes are sufficiently self-explanatory that `git diff master..spwhitton/reboot` will be enough for you to review the branch. If not, I will happily split the commits into several branches.
+
+[1] I changed the haddocks on some functions in Sbuild.hs so that they will be properly hyperlinked, and did some other documentation rearrangements.
+"""]]
diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_9_233140189ee7ffebad687db76dfe2258._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_9_233140189ee7ffebad687db76dfe2258._comment
new file mode 100644
index 00000000..1afbef11
--- /dev/null
+++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_9_233140189ee7ffebad687db76dfe2258._comment
@@ -0,0 +1,22 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 9"""
+ date="2016-06-20T17:56:25Z"
+ content="""
+Félix sent some patches today fixing compiling Propellor.Exception on old
+ghc, which overlap with part of your patch. You addressed the same problem
+in different ways. Since I already merged his (more extensive I think)
+fixes for that, your branch will need to be updated.
+
+The only thing I caught during review is that the documentation for
+useOverlays says that the property has to be added before
+Sbuild.builtFor, but actually info-setting properties
+set info before any properties run, so can safely appear after properties
+that use the info they set!
+
+(I'm not sure if overlaysInTmpfs can safely come after
+Sbuild.builtFor, but if it cannot it's not due to setting useOverlays.)
+
+Also, it would be good to have some lines to add to the changelog
+about the sbuild changes.
+"""]]
diff --git a/propellor.cabal b/propellor.cabal
index dd14fcc0..94b33154 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -99,6 +99,7 @@ Library
Propellor.Property.Docker
Propellor.Property.Fail2Ban
Propellor.Property.File
+ Propellor.Property.Firejail
Propellor.Property.Firewall
Propellor.Property.FreeBSD
Propellor.Property.FreeBSD.Pkg
diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs
index 3ab783bf..463402e4 100644
--- a/src/Propellor/Exception.hs
+++ b/src/Propellor/Exception.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
module Propellor.Exception where
@@ -8,11 +8,15 @@ import Propellor.Message
import Utility.Exception
import Control.Exception (AsyncException)
+#if MIN_VERSION_base(4,7,0)
+import Control.Exception (SomeAsyncException)
+#endif
import Control.Monad.Catch
import Control.Monad.IO.Class (MonadIO)
+import Prelude
-- | Catches all exceptions (except for `StopPropellorException` and
--- `AsyncException`) and returns FailedChange.
+-- `AsyncException` and `SomeAsyncException`) and returns FailedChange.
catchPropellor :: (MonadIO m, MonadCatch m) => m Result -> m Result
catchPropellor a = either err return =<< tryPropellor a
where
@@ -21,6 +25,9 @@ catchPropellor a = either err return =<< tryPropellor a
catchPropellor' :: MonadCatch m => m a -> (SomeException -> m a) -> m a
catchPropellor' a onerr = a `catches`
[ Handler (\ (e :: AsyncException) -> throwM e)
+#if MIN_VERSION_base(4,7,0)
+ , Handler (\ (e :: SomeAsyncException) -> throwM e)
+#endif
, Handler (\ (e :: StopPropellorException) -> throwM e)
, Handler (\ (e :: SomeException) -> onerr e)
]
@@ -28,4 +35,4 @@ catchPropellor' a onerr = a `catches`
-- | Catches all exceptions (except for `StopPropellorException` and
-- `AsyncException`).
tryPropellor :: MonadCatch m => m a -> m (Either SomeException a)
-tryPropellor a = (Right <$> a) `catchPropellor'` (pure . Left)
+tryPropellor a = (return . Right =<< a) `catchPropellor'` (return . Left)
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index af36ed58..7ee9397e 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -16,6 +16,7 @@ module Propellor.Property (
, check
, fallback
, revert
+ , applyToList
-- * Property descriptions
, describe
, (==>)
@@ -53,6 +54,7 @@ import System.Posix.Files
import qualified Data.Hash.MD5 as MD5
import Data.List
import Control.Applicative
+import Data.Foldable hiding (and, elem)
import Prelude
import Propellor.Types
@@ -81,7 +83,7 @@ flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do
go _ _ True = return NoChange
go satisfy flagfile False = do
r <- satisfy
- when (r == MadeChange) $ liftIO $
+ when (r == MadeChange) $ liftIO $
unlessM (doesFileExist flagfile) $ do
createDirectoryIfMissing True (takeDirectory flagfile)
writeFile flagfile ""
@@ -277,7 +279,7 @@ pickOS
, SingI c
-- Would be nice to have this constraint, but
-- union will not generate metatypes lists with the same
- -- order of OS's as is used everywhere else. So,
+ -- order of OS's as is used everywhere else. So,
-- would need a type-level sort.
--, Union a b ~ c
)
@@ -295,7 +297,7 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
then getSatisfy b
else unsupportedOS'
matching Nothing _ = False
- matching (Just o) p =
+ matching (Just o) p =
Targeting (systemToTargetOS o)
`elem`
fromSing (proptype p)
@@ -341,6 +343,14 @@ unsupportedOS' = go =<< getOS
revert :: RevertableProperty setup undo -> RevertableProperty undo setup
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
+-- | Apply a property to each element of a list.
+applyToList
+ :: (Foldable t, Functor t, IsProp p, Combines p p, p ~ CombinedType p p)
+ => (b -> p)
+ -> t b
+ -> p
+prop `applyToList` xs = Data.Foldable.foldr1 before $ prop <$> xs
+
makeChange :: IO () -> Propellor Result
makeChange a = liftIO a >> return MadeChange
diff --git a/src/Propellor/Property/ConfFile.hs b/src/Propellor/Property/ConfFile.hs
index d91c7724..b49c626e 100644
--- a/src/Propellor/Property/ConfFile.hs
+++ b/src/Propellor/Property/ConfFile.hs
@@ -44,7 +44,7 @@ adjustSection desc start past adjust insert = fileProperty desc go
go ls = let (pre, wanted, post) = foldl' find ([], [], []) ls
in if null wanted
then insert ls
- else pre ++ (adjust wanted) ++ post
+ else pre ++ adjust wanted ++ post
find (pre, wanted, post) l
| null wanted && null post && (not . start) l =
(pre ++ [l], wanted, post)
@@ -79,8 +79,7 @@ adjustIniSection desc header =
-- | Ensures that a .ini file exists and contains a section
-- with a key=value setting.
containsIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property UnixLike
-containsIniSetting f (header, key, value) =
- adjustIniSection
+containsIniSetting f (header, key, value) = adjustIniSection
(f ++ " section [" ++ header ++ "] contains " ++ key ++ "=" ++ value)
header
go
@@ -90,28 +89,26 @@ containsIniSetting f (header, key, value) =
confheader = iniHeader header
confline = key ++ "=" ++ value
go [] = [confline]
- go (l:ls) = if isKeyVal l then confline : ls else l : (go ls)
+ go (l:ls) = if isKeyVal l then confline : ls else l : go ls
isKeyVal x = (filter (/= ' ') . takeWhile (/= '=')) x `elem` [key, '#':key]
-- | Ensures that a .ini file exists and contains a section
-- with a given key=value list of settings.
hasIniSection :: FilePath -> IniSection -> [(IniKey, String)] -> Property UnixLike
-hasIniSection f header keyvalues =
- adjustIniSection
+hasIniSection f header keyvalues = adjustIniSection
("set " ++ f ++ " section [" ++ header ++ "]")
header
go
- (++ [confheader] ++ conflines) -- add missing section at end
+ (++ confheader : conflines) -- add missing section at end
f
where
confheader = iniHeader header
conflines = map (\(key, value) -> key ++ "=" ++ value) keyvalues
- go _ = conflines
+ go _ = confheader : conflines
-- | Ensures that a .ini file does not contain the specified section.
lacksIniSection :: FilePath -> IniSection -> Property UnixLike
-lacksIniSection f header =
- adjustIniSection
+lacksIniSection f header = adjustIniSection
(f ++ " lacks section [" ++ header ++ "]")
header
(const []) -- remove all lines of section
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index e072fcaa..95fc6f81 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -1,8 +1,11 @@
+{-# LANGUAGE FlexibleInstances #-}
+
module Propellor.Property.File where
import Propellor.Base
import Utility.FileMode
+import qualified Data.ByteString.Lazy as L
import System.Posix.Files
import System.Exit
@@ -14,10 +17,28 @@ f `hasContent` newcontent = fileProperty
("replace " ++ f)
(\_oldcontent -> newcontent) f
+-- | Ensures that a line is present in a file, adding it to the end if not.
+containsLine :: FilePath -> Line -> Property UnixLike
+f `containsLine` l = f `containsLines` [l]
+
+containsLines :: FilePath -> [Line] -> Property UnixLike
+f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
+ where
+ go content = content ++ filter (`notElem` content) ls
+
+-- | Ensures that a line is not present in a file.
+-- Note that the file is ensured to exist, so if it doesn't, an empty
+-- file will be written.
+lacksLine :: FilePath -> Line -> Property UnixLike
+f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
+
+lacksLines :: FilePath -> [Line] -> Property UnixLike
+f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f
+
-- | Replaces all the content of a file, ensuring that its modes do not
-- allow it to be read or written by anyone other than the current user
hasContentProtected :: FilePath -> [Line] -> Property UnixLike
-f `hasContentProtected` newcontent = fileProperty' writeFileProtected
+f `hasContentProtected` newcontent = fileProperty' ProtectedWrite
("replace " ++ f)
(\_oldcontent -> newcontent) f
@@ -29,9 +50,9 @@ hasPrivContent :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent f = hasPrivContentFrom (PrivDataSourceFile (PrivFile f) f) f
-- | Like hasPrivContent, but allows specifying a source
--- for PrivData, rather than using PrivDataSourceFile .
+-- for PrivData, rather than using `PrivDataSourceFile`.
hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
-hasPrivContentFrom = hasPrivContent' writeFileProtected
+hasPrivContentFrom = hasPrivContent' ProtectedWrite
-- | Leaves the file at its default or current mode,
-- allowing "private" data to be read.
@@ -41,68 +62,30 @@ hasPrivContentExposed :: IsContext c => FilePath -> c -> Property (HasInfo + Uni
hasPrivContentExposed f = hasPrivContentExposedFrom (PrivDataSourceFile (PrivFile f) f) f
hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
-hasPrivContentExposedFrom = hasPrivContent' writeFile
+hasPrivContentExposedFrom = hasPrivContent' NormalWrite
-hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
-hasPrivContent' writer source f context =
+hasPrivContent' :: (IsContext c, IsPrivDataSource s) => FileWriteMode -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
+hasPrivContent' writemode source f context =
withPrivData source context $ \getcontent ->
property' desc $ \o -> getcontent $ \privcontent ->
- ensureProperty o $ fileProperty' writer desc
- (\_oldcontent -> privDataLines privcontent) f
+ ensureProperty o $ fileProperty' writemode desc
+ (\_oldcontent -> privDataByteString privcontent) f
where
desc = "privcontent " ++ f
--- | Ensures that a line is present in a file, adding it to the end if not.
-containsLine :: FilePath -> Line -> Property UnixLike
-f `containsLine` l = f `containsLines` [l]
-
-containsLines :: FilePath -> [Line] -> Property UnixLike
-f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
- where
- go content = content ++ filter (`notElem` content) ls
-
--- | Ensures that a line is not present in a file.
--- Note that the file is ensured to exist, so if it doesn't, an empty
--- file will be written.
-lacksLine :: FilePath -> Line -> Property UnixLike
-f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
-
-lacksLines :: FilePath -> [Line] -> Property UnixLike
-f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f
-
-- | 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'
ensureProperty o $ fileProperty desc (\_ -> a $ lines $ tmpl) f
where
- desc = "replace " ++ f
+ desc = f ++ " is based on " ++ f'
-- | Removes a file. Does not remove symlinks or non-plain-files.
notPresent :: FilePath -> Property UnixLike
notPresent f = check (doesFileExist f) $ property (f ++ " not present") $
makeChange $ nukeFile f
-fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike
-fileProperty = fileProperty' writeFile
-fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike
-fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
- where
- go True = do
- old <- liftIO $ readFile f
- let new = unlines (a (lines old))
- if old == new
- then noChange
- else makeChange $ updatefile new `viaStableTmp` f
- go False = makeChange $ writer f (unlines $ a [])
-
- -- Replicate the original file's owner and mode.
- updatefile content f' = do
- writer f' content
- s <- getFileStatus f
- setFileMode f' (fileMode s)
- setOwnerAndGroup f' (fileOwner s) (fileGroup s)
-
-- | Ensures a directory exists.
dirExists :: FilePath -> Property UnixLike
dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $
@@ -172,6 +155,49 @@ mode f v = p `changesFile` f
liftIO $ modifyFileMode f (const v)
return NoChange
+class FileContent c where
+ emptyFileContent :: c
+ readFileContent :: FilePath -> IO c
+ writeFileContent :: FileWriteMode -> FilePath -> c -> IO ()
+
+data FileWriteMode = NormalWrite | ProtectedWrite
+
+instance FileContent [Line] where
+ emptyFileContent = []
+ readFileContent f = lines <$> readFile f
+ writeFileContent NormalWrite f ls = writeFile f (unlines ls)
+ writeFileContent ProtectedWrite f ls = writeFileProtected f (unlines ls)
+
+instance FileContent L.ByteString where
+ emptyFileContent = L.empty
+ readFileContent = L.readFile
+ writeFileContent NormalWrite f c = L.writeFile f c
+ writeFileContent ProtectedWrite f c =
+ writeFileProtected' f (`L.hPutStr` c)
+
+-- | A property that applies a pure function to the content of a file.
+fileProperty :: (FileContent c, Eq c) => Desc -> (c -> c) -> FilePath -> Property UnixLike
+fileProperty = fileProperty' NormalWrite
+fileProperty' :: (FileContent c, Eq c) => FileWriteMode -> Desc -> (c -> c) -> FilePath -> Property UnixLike
+fileProperty' writemode desc a f = property desc $ go =<< liftIO (doesFileExist f)
+ where
+ go True = do
+ old <- liftIO $ readFileContent f
+ let new = a old
+ if old == new
+ then noChange
+ else makeChange $ updatefile new `viaStableTmp` f
+ go False = makeChange $ writer f (a emptyFileContent)
+
+ -- Replicate the original file's owner and mode.
+ updatefile content dest = do
+ writer dest content
+ s <- getFileStatus f
+ setFileMode dest (fileMode s)
+ setOwnerAndGroup dest (fileOwner s) (fileGroup s)
+
+ writer = writeFileContent writemode
+
-- | A temp file to use when writing new content for a file.
--
-- This is a stable name so it can be removed idempotently.
diff --git a/src/Propellor/Property/Firejail.hs b/src/Propellor/Property/Firejail.hs
new file mode 100644
index 00000000..b7841e07
--- /dev/null
+++ b/src/Propellor/Property/Firejail.hs
@@ -0,0 +1,31 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+module Propellor.Property.Firejail (
+ installed,
+ jailed,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
+
+-- | Ensures that Firejail is installed
+installed :: Property DebianLike
+installed = Apt.installed ["firejail"]
+
+-- | For each program name passed, create symlinks in /usr/local/bin that
+-- will launch that program in a Firejail sandbox.
+--
+-- The profile for the sandbox will be the same as if the user had run
+-- @firejail@ directly without passing @--profile@ (see "SECURITY PROFILES" in
+-- firejail(1)).
+--
+-- See "DESKTOP INTEGRATION" in firejail(1).
+jailed :: [String] -> Property DebianLike
+jailed ps = (jailed' `applyToList` ps)
+ `requires` installed
+ `describe` unwords ("firejail jailed":ps)
+
+jailed' :: String -> Property UnixLike
+jailed' p = ("/usr/local/bin" </> p)
+ `File.isSymlinkedTo` File.LinkTarget "/usr/bin/firejail"
diff --git a/src/Propellor/Types/Exception.hs b/src/Propellor/Types/Exception.hs
index 3a810d55..9fdcab93 100644
--- a/src/Propellor/Types/Exception.hs
+++ b/src/Propellor/Types/Exception.hs
@@ -1,10 +1,11 @@
+{-# LANGUAGE DeriveDataTypeable #-}
module Propellor.Types.Exception where
import Data.Typeable
import Control.Exception
--- | Normally when an exception is encountered while propellor is
--- ensuring a property, the property fails, but propellor robustly
+-- | Normally when an exception is encountered while propellor is
+-- ensuring a property, the property fails, but propellor robustly
-- continues on to the next property.
--
-- This is the only exception that will stop the entire propellor run,
diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs
index e691f13b..f6551b45 100644
--- a/src/Utility/Exception.hs
+++ b/src/Utility/Exception.hs
@@ -5,7 +5,7 @@
- License: BSD-2-clause
-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Exception (
@@ -28,6 +28,9 @@ module Utility.Exception (
import Control.Monad.Catch as X hiding (Handler)
import qualified Control.Monad.Catch as M
import Control.Exception (IOException, AsyncException)
+#if MIN_VERSION_base(4,7,0)
+import Control.Exception (SomeAsyncException)
+#endif
import Control.Monad
import Control.Monad.IO.Class (liftIO, MonadIO)
import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
@@ -74,6 +77,9 @@ bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup)
catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a
catchNonAsync a onerr = a `catches`
[ M.Handler (\ (e :: AsyncException) -> throwM e)
+#if MIN_VERSION_base(4,7,0)
+ , M.Handler (\ (e :: SomeAsyncException) -> throwM e)
+#endif
, M.Handler (\ (e :: SomeException) -> onerr e)
]