summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog3
-rw-r--r--doc/forum/newbie_trying_to_set_up_NFS_mount/comment_2_90831d9859cfe0c6dafe029584b3deef._comment17
-rw-r--r--doc/forum/newbie_trying_to_set_up_NFS_mount/comment_3_a82855697a268a4f2165db717a652516._comment28
-rw-r--r--doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment17
-rw-r--r--doc/forum/upgrading_to_propellor_3.0.mdwn8
-rw-r--r--doc/forum/upgrading_to_propellor_3.0/comment_1_ddf4b31102bf16a34afaa6f77e8464d1._comment135
-rw-r--r--doc/forum/upgrading_to_propellor_3.0/comment_2_ce961eb3a2a006ecce09eb7f9bd550cf._comment63
-rw-r--r--doc/forum/upgrading_to_propellor_3.0/comment_3_88584d22eb238dc172cb3b4f2f6d30fc._comment8
-rw-r--r--doc/forum/upgrading_to_propellor_3.0/comment_4_71afd4663589c1aad367c071c6cdd24a._comment12
-rw-r--r--doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn (renamed from doc/forum/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn)2
-rw-r--r--doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment (renamed from doc/forum/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment)0
-rw-r--r--doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_2_bd695a2e9ab90b355a71388dc6e7205d._comment7
-rw-r--r--doc/todo/type_level_port_conflict_detection.mdwn31
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Property/Apt.hs24
-rw-r--r--src/Propellor/Property/DiskImage.hs1
-rw-r--r--src/Propellor/Property/Fstab.hs111
-rw-r--r--src/Propellor/Property/Mount.hs84
-rw-r--r--src/System/Console/Concurrent/Internal.hs13
19 files changed, 458 insertions, 107 deletions
diff --git a/debian/changelog b/debian/changelog
index ba3f31c2..3c3d41ac 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,9 @@ propellor (3.0.2) UNRELEASED; urgency=medium
* Added Apt.periodicUpdates.
Thanks, Félix Sipma.
+ * Apt.unattendedUpgrades: Enable mailing problems reports to root.
+ Thanks, Félix Sipma.
+ * Added Propellor.Property.Fstab, and moved the fstabbed property to there.
-- Joey Hess <id@joeyh.name> Tue, 05 Apr 2016 13:48:47 -0400
diff --git a/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_2_90831d9859cfe0c6dafe029584b3deef._comment b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_2_90831d9859cfe0c6dafe029584b3deef._comment
new file mode 100644
index 00000000..b21a6973
--- /dev/null
+++ b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_2_90831d9859cfe0c6dafe029584b3deef._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 2"
+ date="2016-04-06T12:17:09Z"
+ content="""
+I agreed with you joey, we need to be able to add mount point directly into the fstab file in order to let the world know about all the mount points.
+Maybe a way also to generate the mount point with the system d syntax.
+
+So maybe the best solution is to have a DSL (like you did in you dism system) and then generators for fstab, systemd, etc...
+This property should be revertable in order to add or remove lines (files).
+
+the fstab should also contain some invariant code (the lines generated during the system installation). I speak about Debian installation.
+
+Cheers
+
+Fred
+"""]]
diff --git a/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_3_a82855697a268a4f2165db717a652516._comment b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_3_a82855697a268a4f2165db717a652516._comment
new file mode 100644
index 00000000..f2274c05
--- /dev/null
+++ b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_3_a82855697a268a4f2165db717a652516._comment
@@ -0,0 +1,28 @@
+[[!comment format=mdwn
+ username="frederik@ffbea6a549cb3f460d110386c0f634c1ddc6a68a"
+ nickname="frederik"
+ subject="comment 3"
+ date="2016-04-06T14:14:23Z"
+ content="""
+I tried adding
+
+ & File.dirExists \"/mnt/nfs\"
+ & \"/etc/fstab\" `File.containsLine` \"192.168.1.100:/mnt/usb1 /mnt/nfs nfs intr 0 0\"
+ `onChange` cmdProperty \"mount\" [\"-a\"]
+
+This mimicks the bitlbee example on /usr/local/propellor/config-joey.hs
+
+But that results:
+
+ src/config.hs:36:11:
+ No instance for (Combines
+ (Property NoInfo) (UncheckedProperty NoInfo))
+ arising from a use of ‘onChange’
+ In the second argument of ‘(&)’, namely
+ ‘\"/etc/fstab\"
+ `File.containsLine` \"192.168.1.100:/mnt/usb1 /mnt/nfs nfs intr 0 0\"
+ `onChange` cmdProperty \"mount\" [\"-a\"]’
+
+
+
+"""]]
diff --git a/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment
new file mode 100644
index 00000000..74c959e8
--- /dev/null
+++ b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-04-07T04:21:39Z"
+ content="""
+That's quite a nice elegant solution, Frederik!
+
+It'll work if you use
+
+ `onChange` (cmdProperty "mount" ["-a"] `assume` MadeChange)
+
+This is ncessary because propellor doesn't know if `cmdProperty`
+makes a change or not. In this case we can just assume it did.
+
+I've added a `Propellor.Property.Fstab.mounted` this evening
+that is essentially Frederik's solution.
+"""]]
diff --git a/doc/forum/upgrading_to_propellor_3.0.mdwn b/doc/forum/upgrading_to_propellor_3.0.mdwn
index a6857ce4..b81a6a94 100644
--- a/doc/forum/upgrading_to_propellor_3.0.mdwn
+++ b/doc/forum/upgrading_to_propellor_3.0.mdwn
@@ -6,14 +6,6 @@ This prevents using eg, Property FreeBSD on a Debian system.
This forum topic is to help users with the upgrade. Post comments
if you're having trouble and [[Joey]] will get back to you. ;)
-First things first: In order to upgrade to propellor 3.0, you **must first
-upgrade to propellor 2.17.2**, and deploy that to all your hosts. If you
-skip this step, propellor --spin will fail when you upgrade to propellor
-3.0.0.
-(Workaround: ssh to host, cd /usr/local/propellor && make clean,
-then you can re-run propellor --spin.)
-[[details_of_why_this_two_step_upgrade_is_needed|todo/problem_with_spin_after_new_dependencies_added]]
-
Now, the transition guide as far as your config.hs goes:
* Add `props` to host definitions.
diff --git a/doc/forum/upgrading_to_propellor_3.0/comment_1_ddf4b31102bf16a34afaa6f77e8464d1._comment b/doc/forum/upgrading_to_propellor_3.0/comment_1_ddf4b31102bf16a34afaa6f77e8464d1._comment
new file mode 100644
index 00000000..da4ee68b
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0/comment_1_ddf4b31102bf16a34afaa6f77e8464d1._comment
@@ -0,0 +1,135 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="How to migrate this property"
+ date="2016-04-13T08:52:10Z"
+ content="""
+Hello, I am trying to migrate this property
+
+ -- | Property used to setup a schroot used by sbuild
+ -- > schroot \"jessie-i386-sbuild\"
+ -- > debootstrapped Debootstrap.BuildD \"/srv/chroot/ghc-dev\"
+ -- > & os (System (Debian (Stable \"jessie\")) \"i386\")
+ -- > & Apt.installed [\"ghc\", \"haskell-platform\"]
+ -- > & ...
+ schroot :: SchrootName -> Chroot -> RevertableProperty (HasInfo + DebianLike) DebianLike
+ schroot sn chroot@(Chroot.Chroot chrootdir _ _) = (setup `requires` installed) <!> cleanup
+ where
+ setup :: Property (HasInfo + DebianLike)
+ setup = conf `requires` (provision `onChange` targz)
+ where
+ provision :: Property (HasInfo + DebianLike)
+ provision = toChildProperty (Chroot.provisioned chroot) `before` umount
+ where
+ umount = property (\"umount \" ++ chrootdir) $ do
+ liftIO $ Mount.unmountBelow chrootdir
+ return NoChange
+ targz = createTarball chrootdir tarball
+ conf = chrootConf sn tarball
+ cleanup :: Property DebianLike
+ cleanup = File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` toChildProperty (revert (Chroot.provisioned chroot))
+ tarball = chrootdir <.> \"tar.gz\"
+
+
+and when I compile it I get this error message
+
+ src/Propellor/Property/Sbuild.hs:79:25-83:
+
+ Couldn't match type ‘CombinedType
+ ChildProperty (Property (MetaTypes metatypes1))’
+ with ‘Property
+ (MetaTypes
+ '['WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])’
+ The type variable ‘metatypes1’ is ambiguous
+ Expected type: Property (HasInfo + DebianLike)
+ Actual type: CombinedType
+ ChildProperty (Property (MetaTypes metatypes1))
+ Relevant bindings include
+ umount :: Property (MetaTypes metatypes1)
+ (bound at src/Propellor/Property/Sbuild.hs:81:19)
+ In the expression:
+ toChildProperty (Chroot.provisioned chroot) `before` umount
+ In an equation for ‘provision’:
+ provision
+ = toChildProperty (Chroot.provisioned chroot) `before` umount
+ where
+ umount
+ = property (\"umount \" ++ chrootdir)
+ $ do { liftIO $ Mount.unmountBelow chrootdir;
+ .... }
+ In an equation for ‘setup’:
+ setup
+ = conf `requires` (provision `onChange` targz)
+ where
+ provision :: Property (HasInfo + DebianLike)
+ provision
+ = toChildProperty (Chroot.provisioned chroot) `before` umount
+ where
+ umount = property (\"umount \" ++ chrootdir) $ ...
+ targz = createTarball chrootdir tarball
+ conf = chrootConf sn tarball
+
+ src/Propellor/Property/Sbuild.hs:(87,17)-(89,79):
+
+ Couldn't match expected type ‘Property DebianLike’
+ with actual type ‘CombinedType
+ (Property
+ (MetaTypes
+ '['Targeting 'OSDebian, 'Targeting 'OSBuntish,
+ 'Targeting 'OSFreeBSD]))
+ ChildProperty’
+ In the expression:
+ File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` toChildProperty (revert (Chroot.provisioned chroot))
+ In an equation for ‘cleanup’:
+ cleanup
+ = File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` toChildProperty (revert (Chroot.provisioned chroot))
+ In an equation for ‘schroot’:
+ schroot sn chroot@(Chroot.Chroot chrootdir _ _)
+ = (setup `requires` installed) <!> cleanup
+ where
+ setup :: Property (HasInfo + DebianLike)
+ setup
+ = conf `requires` (provision `onChange` targz)
+ where
+ provision :: Property (HasInfo + DebianLike)
+ provision
+ = toChildProperty (Chroot.provisioned chroot) `before` umount
+ where
+ ...
+ ....
+ cleanup :: Property DebianLike
+ cleanup
+ = File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` toChildProperty (revert (Chroot.provisioned chroot))
+ ....
+
+ src/Propellor/Property/Sbuild.hs:98:18-42:
+
+ Couldn't match expected type ‘Property DebianLike’
+ with actual type ‘CombinedType
+ (Property (MetaTypes metatypes0)) (Property DebianLike)’
+ The type variable ‘metatypes0’ is ambiguous
+ Relevant bindings include
+ prop :: Property (MetaTypes metatypes0)
+ (bound at src/Propellor/Property/Sbuild.hs:100:5)
+ In the expression: prop `requires` installed
+ In an equation for ‘addUsers’:
+ addUsers users
+ = prop `requires` installed
+ where
+ prop
+ = property (\"sbuild add users \" ++ unwords names)
+ $ liftIO
+ $ toResult
+ <$> boolSystem \"sbuild-adduser\" [Param user | user <- names]
+ where
+ names = ...
+
+so my question is what is wrong with my code :))
+"""]]
diff --git a/doc/forum/upgrading_to_propellor_3.0/comment_2_ce961eb3a2a006ecce09eb7f9bd550cf._comment b/doc/forum/upgrading_to_propellor_3.0/comment_2_ce961eb3a2a006ecce09eb7f9bd550cf._comment
new file mode 100644
index 00000000..91f22a3b
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0/comment_2_ce961eb3a2a006ecce09eb7f9bd550cf._comment
@@ -0,0 +1,63 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-04-13T16:14:46Z"
+ content="""
+There are a few things in your example that seem to reference other
+parts of your schroot module, which I don't have handy. But, I was able
+to add dummy versions of those (hopefully with close to the real types)
+and reproduce what looks like the same type errors.
+
+Let's first deal with "type variable x is ambiguous". Because if the type
+checker cannot infer a type, the other errors are not likely to be useful.
+
+So, the first of these involves the definition of `umount`, which uses
+`property`. And like it says in the transition guide:
+
+> Due to the polymorphic type returned by `property`, additional type
+> signatures tend to be needed when using it.
+
+So, write down the type of `umount` to fix this.
+
+ umount :: Property Linux
+
+Next thing that stuck out to me is that two places are using
+`toChildProperty`. I'm at a bit of a loss to why, this is a new function
+that's a bit of an implementation detail, documented as "Gets a
+ChildProperty representing the Property. You should not normally need to
+use this." And indeed, you do not need to use it here. I simply removed it,
+and the types lined up without it, hurrah!
+
+With those fixes, my version of the code is compiling.
+
+ schroot :: String -> Chroot -> RevertableProperty (HasInfo + DebianLike) DebianLike
+ schroot sn chroot@(Chroot.Chroot chrootdir _ _) = (setup `requires` installed) <!> cleanup
+ where
+ setup :: Property (HasInfo + DebianLike)
+ setup = conf `requires` (provision `onChange` targz)
+ where
+ provision :: Property (HasInfo + DebianLike)
+ provision = Chroot.provisioned chroot `before` umount
+ where
+ umount :: Property Linux
+ umount = property ("umount " ++ chrootdir) $ do
+ liftIO $ Mount.unmountBelow chrootdir
+ return NoChange
+ cleanup :: Property DebianLike
+ cleanup = File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` revert (Chroot.provisioned chroot)
+ tarball = chrootdir <.> "tar.gz"
+ -- dummy stuff added to make it compile as I don't have the real
+ -- stuff handy.
+ installed = undefined :: Property DebianLike
+ conf = undefined :: Property DebianLike
+ targz = undefined :: Property DebianLike
+ schrootChrootD = undefined :: FilePath
+
+Hope this helps!
+
+BTW, looks like you also have a type error outside the code you showed,
+on line 98 of Sbuild.hs, which again looks to need the type of `property`
+to be explicitly specified to fix it.
+"""]]
diff --git a/doc/forum/upgrading_to_propellor_3.0/comment_3_88584d22eb238dc172cb3b4f2f6d30fc._comment b/doc/forum/upgrading_to_propellor_3.0/comment_3_88584d22eb238dc172cb3b4f2f6d30fc._comment
new file mode 100644
index 00000000..8f1d290e
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0/comment_3_88584d22eb238dc172cb3b4f2f6d30fc._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 3"
+ date="2016-04-15T18:42:46Z"
+ content="""
+Thanks to your help I could convert my config.h... BUT now the compilation of my config.hs files eat all my RAM and faild after filling all the swap.
+I have a small computer i386 with only 700 Mo of RAM. Are you aware of this sort of \"side effect\" ;) with 3.0.1 ?
+"""]]
diff --git a/doc/forum/upgrading_to_propellor_3.0/comment_4_71afd4663589c1aad367c071c6cdd24a._comment b/doc/forum/upgrading_to_propellor_3.0/comment_4_71afd4663589c1aad367c071c6cdd24a._comment
new file mode 100644
index 00000000..fd9c192d
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0/comment_4_71afd4663589c1aad367c071c6cdd24a._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-04-15T22:58:44Z"
+ content="""
+Memory use did go up. Building with -O0 helped a lot for me, and it's doing
+ok on a 500 mb memory machine. So I recommend -O0 in your cabal file if you
+don't have that already.
+
+I wrote down my memory benchmarks here:
+<http://source.propellor.branchable.com/?p=source.git;a=commit;h=af7b2d61c0c7f9b4fe53d8f5d18b5426a93cbd7b>
+"""]]
diff --git a/doc/forum/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn
index c40b29ef..d8493b27 100644
--- a/doc/forum/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn
+++ b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn
@@ -1,3 +1,5 @@
The recent dependency on concurrent-output adding implies downloading, compiling, and executing as root of many (MissingH, hslogger, process, unix-compat, network, directory, ansi-terminal, unix, ...) unstrusted sources. This seems like a huge security problem...
Are these at least downloaded using https?
+
+> [[done]] --[[Joey]]
diff --git a/doc/forum/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment
index 39836219..39836219 100644
--- a/doc/forum/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment
+++ b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment
diff --git a/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_2_bd695a2e9ab90b355a71388dc6e7205d._comment b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_2_bd695a2e9ab90b355a71388dc6e7205d._comment
new file mode 100644
index 00000000..5c17f1bb
--- /dev/null
+++ b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_2_bd695a2e9ab90b355a71388dc6e7205d._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 2"
+ date="2016-04-05T18:41:31Z"
+ content="""
+great! thanks
+"""]]
diff --git a/doc/todo/type_level_port_conflict_detection.mdwn b/doc/todo/type_level_port_conflict_detection.mdwn
index b89ad239..67f63e03 100644
--- a/doc/todo/type_level_port_conflict_detection.mdwn
+++ b/doc/todo/type_level_port_conflict_detection.mdwn
@@ -33,3 +33,34 @@ but it is not yet integrated into the Property types. --[[Joey]]
> port. Don't allow combining `UsingPort 80 Apache` with `UsingPort 80 Ngnix`
>
> --[[Joey]]
+
+> > Also, it's not clear how to parameterize properties that support
+> > running a service on different ports. One way might be to
+> > declare the ports in the type signatures; the property code
+> > can then use `usedPorts (getMetaTypes self)` to get a port list.
+> >
+> > So, we'd start with a property definition that does not use any ports:
+> >
+> > virtualHost :: Domain -> WebRoot -> RevertableProperty DebianLike DebianLike
+> > virtualHost domain docroot =
+> > let self = property "vhost" (go (usedPorts (getMetaTypes self)))
+> > in self
+> > where
+> > go [] = error "No ports specified"
+> > go ports = ...
+> >
+> > And then to use it:
+> >
+> > & virtualHost "example.com" "/var/www" :: RevertableProperty (UsingPort 80 + DebianLike) DebianLike
+> >
+> > But, this seems like a mouthful to write!
+> >
+> > Maybe make a `using` that changes the metatypes of a property,
+> > adding a resource. That shortens what needs to be written some:
+> >
+> > & virtualHost "example.com" "/var/www" `using` (port :: Port 80)
+> >
+> > (`port` here is just an alias for `sing`, possibly constrained to only
+> > construct port singletons.)
+> >
+> > --[[Joey]]
diff --git a/propellor.cabal b/propellor.cabal
index 322d135e..7f12cbec 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -98,6 +98,7 @@ Library
Propellor.Property.FreeBSD
Propellor.Property.FreeBSD.Pkg
Propellor.Property.FreeBSD.Poudriere
+ Propellor.Property.Fstab
Propellor.Property.Git
Propellor.Property.Gpg
Propellor.Property.Group
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 58a83c43..5e185a0e 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -249,15 +249,21 @@ unattendedUpgrades = enable <!> disable
| otherwise = "false"
configure :: Property DebianLike
- configure = withOS "unattended upgrades configured" $ \w o ->
- case o of
- -- the package defaults to only upgrading stable
- (Just (System (Debian suite) _))
- | not (isStable suite) -> ensureProperty w $
- "/etc/apt/apt.conf.d/50unattended-upgrades"
- `File.containsLine`
- ("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")
- _ -> noChange
+ configure = propertyList "unattended upgrades configured" $ props
+ & enableupgrading
+ & unattendedconfig `File.containsLine` "Unattended-Upgrade::Mail \"root\";"
+ where
+ enableupgrading :: Property DebianLike
+ enableupgrading = withOS "unattended upgrades configured" $ \w o ->
+ case o of
+ -- the package defaults to only upgrading stable
+ (Just (System (Debian suite) _))
+ | not (isStable suite) -> ensureProperty w $
+ unattendedconfig
+ `File.containsLine`
+ ("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")
+ _ -> noChange
+ unattendedconfig = "/etc/apt/apt.conf.d/50unattended-upgrades"
-- | Enable periodic updates (but not upgrades), including download
-- of packages.
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 718768c2..afeaa287 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -30,6 +30,7 @@ import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.Parted
import Propellor.Property.Mount
+import Propellor.Property.Fstab (SwapPartition(..), genFstab)
import Propellor.Property.Partition
import Propellor.Property.Rsync
import Propellor.Container
diff --git a/src/Propellor/Property/Fstab.hs b/src/Propellor/Property/Fstab.hs
new file mode 100644
index 00000000..60f11d8e
--- /dev/null
+++ b/src/Propellor/Property/Fstab.hs
@@ -0,0 +1,111 @@
+module Propellor.Property.Fstab (
+ FsType,
+ Source,
+ MountPoint,
+ MountOpts(..),
+ module Propellor.Property.Fstab,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import Propellor.Property.Mount
+
+import Data.Char
+import Data.List
+import Utility.Table
+
+-- | Ensures that </etc/fstab> contains a line mounting the specified
+-- `Source` on the specified `MountPoint`, and that it's currently mounted.
+--
+-- For example:
+--
+-- > mounted "auto" "/dev/sdb1" "/srv" mempty
+--
+-- Note that if anything else is already mounted at the `MountPoint`, it
+-- will be left as-is by this property.
+mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property Linux
+mounted fs src mnt opts = tightenTargets $
+ "/etc/fstab" `File.containsLine` l
+ `describe` (mnt ++ " mounted by fstab")
+ `onChange` mountnow
+ where
+ l = intercalate "\t" [src, mnt, fs, formatMountOpts opts, dump, passno]
+ dump = "0"
+ passno = "2"
+ -- This use of mountPoints, which is linux-only, is why this
+ -- property currently only supports linux.
+ mountnow = check (notElem mnt <$> mountPoints) $
+ cmdProperty "mount" [mnt]
+
+newtype SwapPartition = SwapPartition FilePath
+
+-- | Replaces </etc/fstab> with a file that should cause the currently
+-- mounted partitions to be re-mounted the same way on boot.
+--
+-- For each specified MountPoint, the UUID of each partition
+-- (or if there is no UUID, its label), its filesystem type,
+-- and its mount options are all automatically probed.
+--
+-- The SwapPartitions are also included in the generated fstab.
+fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux
+fstabbed mnts swaps = property' "fstabbed" $ \o -> do
+ fstab <- liftIO $ genFstab mnts swaps id
+ ensureProperty o $
+ "/etc/fstab" `File.hasContent` fstab
+
+genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String]
+genFstab mnts swaps mnttransform = do
+ fstab <- liftIO $ mapM getcfg (sort mnts)
+ swapfstab <- liftIO $ mapM getswapcfg swaps
+ return $ header ++ formatTable (legend : fstab ++ swapfstab)
+ where
+ header =
+ [ "# /etc/fstab: static file system information. See fstab(5)"
+ , "# "
+ ]
+ legend = ["# <file system>", "<mount point>", "<type>", "<options>", "<dump>", "<pass>"]
+ getcfg mnt = sequence
+ [ fromMaybe (error $ "unable to find mount source for " ++ mnt)
+ <$> getM (\a -> a mnt)
+ [ uuidprefix getMountUUID
+ , sourceprefix getMountLabel
+ , getMountSource
+ ]
+ , pure (mnttransform mnt)
+ , fromMaybe "auto" <$> getFsType mnt
+ , formatMountOpts <$> getFsMountOpts mnt
+ , pure "0"
+ , pure (if mnt == "/" then "1" else "2")
+ ]
+ getswapcfg (SwapPartition swap) = sequence
+ [ fromMaybe swap <$> getM (\a -> a swap)
+ [ uuidprefix getSourceUUID
+ , sourceprefix getSourceLabel
+ ]
+ , pure "none"
+ , pure "swap"
+ , pure (formatMountOpts mempty)
+ , pure "0"
+ , pure "0"
+ ]
+ prefix s getter m = fmap (s ++) <$> getter m
+ uuidprefix = prefix "UUID="
+ sourceprefix = prefix "LABEL="
+
+-- | Checks if </etc/fstab> is not configured.
+-- This is the case if it doesn't exist, or
+-- consists entirely of blank lines or comments.
+--
+-- So, if you want to only replace the fstab once, and then never touch it
+-- again, allowing local modifications:
+--
+-- > check noFstab (fstabbed mnts [])
+noFstab :: IO Bool
+noFstab = ifM (doesFileExist "/etc/fstab")
+ ( null . filter iscfg . lines <$> readFile "/etc/fstab"
+ , return True
+ )
+ where
+ iscfg l
+ | null l = False
+ | otherwise = not $ "#" `isPrefixOf` dropWhile isSpace l
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index 943986c6..bb0f60a7 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -1,14 +1,15 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}
+-- | Properties in this module ensure that things are currently mounted,
+-- but without making the mount persistent. Use `Propellor.Property.Fstab`
+-- to configure persistent mounts.
+
module Propellor.Property.Mount where
import Propellor.Base
-import qualified Propellor.Property.File as File
import Utility.Path
-import Data.Char
import Data.List
-import Utility.Table
-- | type of filesystem to mount ("auto" to autodetect)
type FsType = String
@@ -20,6 +21,8 @@ type Source = String
type MountPoint = FilePath
-- | Filesystem mount options. Eg, MountOpts ["errors=remount-ro"]
+--
+-- For default mount options, use `mempty`.
newtype MountOpts = MountOpts [String]
deriving Monoid
@@ -36,7 +39,7 @@ formatMountOpts :: MountOpts -> String
formatMountOpts (MountOpts []) = "defaults"
formatMountOpts (MountOpts l) = intercalate "," l
--- | Mounts a device.
+-- | Mounts a device, without listing it in </etc/fstab>.
mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike
mounted fs src mnt opts = property (mnt ++ " mounted") $
toResult <$> liftIO (mount fs src mnt opts)
@@ -57,79 +60,6 @@ mount fs src mnt opts = boolSystem "mount" $
, Param mnt
]
-newtype SwapPartition = SwapPartition FilePath
-
--- | Replaces </etc/fstab> with a file that should cause the currently
--- mounted partitions to be re-mounted the same way on boot.
---
--- For each specified MountPoint, the UUID of each partition
--- (or if there is no UUID, its label), its filesystem type,
--- and its mount options are all automatically probed.
---
--- The SwapPartitions are also included in the generated fstab.
-fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux
-fstabbed mnts swaps = property' "fstabbed" $ \o -> do
- fstab <- liftIO $ genFstab mnts swaps id
- ensureProperty o $
- "/etc/fstab" `File.hasContent` fstab
-
-genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String]
-genFstab mnts swaps mnttransform = do
- fstab <- liftIO $ mapM getcfg (sort mnts)
- swapfstab <- liftIO $ mapM getswapcfg swaps
- return $ header ++ formatTable (legend : fstab ++ swapfstab)
- where
- header =
- [ "# /etc/fstab: static file system information. See fstab(5)"
- , "# "
- ]
- legend = ["# <file system>", "<mount point>", "<type>", "<options>", "<dump>", "<pass>"]
- getcfg mnt = sequence
- [ fromMaybe (error $ "unable to find mount source for " ++ mnt)
- <$> getM (\a -> a mnt)
- [ uuidprefix getMountUUID
- , sourceprefix getMountLabel
- , getMountSource
- ]
- , pure (mnttransform mnt)
- , fromMaybe "auto" <$> getFsType mnt
- , formatMountOpts <$> getFsMountOpts mnt
- , pure "0"
- , pure (if mnt == "/" then "1" else "2")
- ]
- getswapcfg (SwapPartition swap) = sequence
- [ fromMaybe swap <$> getM (\a -> a swap)
- [ uuidprefix getSourceUUID
- , sourceprefix getSourceLabel
- ]
- , pure "none"
- , pure "swap"
- , pure (formatMountOpts mempty)
- , pure "0"
- , pure "0"
- ]
- prefix s getter m = fmap (s ++) <$> getter m
- uuidprefix = prefix "UUID="
- sourceprefix = prefix "LABEL="
-
--- | Checks if </etc/fstab> is not configured.
--- This is the case if it doesn't exist, or
--- consists entirely of blank lines or comments.
---
--- So, if you want to only replace the fstab once, and then never touch it
--- again, allowing local modifications:
---
--- > check noFstab (fstabbed mnts [])
-noFstab :: IO Bool
-noFstab = ifM (doesFileExist "/etc/fstab")
- ( null . filter iscfg . lines <$> readFile "/etc/fstab"
- , return True
- )
- where
- iscfg l
- | null l = False
- | otherwise = not $ "#" `isPrefixOf` dropWhile isSpace l
-
-- | Lists all mount points of the system.
mountPoints :: IO [MountPoint]
mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]
diff --git a/src/System/Console/Concurrent/Internal.hs b/src/System/Console/Concurrent/Internal.hs
index 6426f37d..ffe6a9e8 100644
--- a/src/System/Console/Concurrent/Internal.hs
+++ b/src/System/Console/Concurrent/Internal.hs
@@ -34,7 +34,6 @@ import qualified Data.Text as T
import qualified Data.Text.IO as T
import Control.Applicative
import Prelude
-import System.Log.Logger
import Utility.Monad
import Utility.Exception
@@ -290,30 +289,18 @@ fgProcess p = do
r@(_, _, _, h) <- P.createProcess p
`onException` dropOutputLock
registerOutputThread
- debug ["fgProcess", showProc p]
-- Wait for the process to exit and drop the lock.
asyncProcessWaiter $ do
void $ tryIO $ P.waitForProcess h
unregisterOutputThread
dropOutputLock
- debug ["fgProcess done", showProc p]
return (toConcurrentProcessHandle r)
-
-debug :: [String] -> IO ()
-debug = debugM "concurrent-output" . unwords
-
-showProc :: P.CreateProcess -> String
-showProc = go . P.cmdspec
- where
- go (P.ShellCommand s) = s
- go (P.RawCommand c ps) = show (c, ps)
#ifndef mingw32_HOST_OS
bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
bgProcess p = do
(toouth, fromouth) <- pipe
(toerrh, fromerrh) <- pipe
- debug ["bgProcess", showProc p]
let p' = p
{ P.std_out = rediroutput (P.std_out p) toouth
, P.std_err = rediroutput (P.std_err p) toerrh