summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/EnsureProperty.hs2
-rw-r--r--src/Propellor/Gpg.hs2
-rw-r--r--src/Propellor/Property.hs13
-rw-r--r--src/Propellor/Property/Borg.hs13
-rw-r--r--src/Propellor/Property/Cron.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs8
-rw-r--r--src/Propellor/Property/Systemd.hs19
-rw-r--r--src/Propellor/Utilities.hs8
9 files changed, 44 insertions, 25 deletions
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index 6c720e2b..ab624706 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -7,7 +7,7 @@
module Propellor.EnsureProperty
( ensureProperty
, property'
- , OuterMetaTypesWitness(..)
+ , OuterMetaTypesWitness
, Cannot_ensureProperty_WithInfo
) where
diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs
index c48bc060..53e7ad5a 100644
--- a/src/Propellor/Gpg.hs
+++ b/src/Propellor/Gpg.hs
@@ -13,11 +13,13 @@ import Propellor.Message
import Propellor.Git.Config
import Utility.SafeCommand
import Utility.Process
+import Utility.Process.Transcript
import Utility.Process.NonConcurrent
import Utility.Monad
import Utility.Misc
import Utility.Tmp
import Utility.Env
+import Utility.Env.Set
import Utility.Directory
import Utility.Split
import Utility.Exception
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 8c0a5859..54dd8908 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -303,7 +303,8 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
where
-- This use of getSatisfy is safe, because both a and b
-- are added as children, so their info will propigate.
- c = withOS (getDesc a) $ \_ o ->
+ c = property (getDesc a) $ do
+ o <- getOS
if matching o a
then maybe (pure NoChange) id (getSatisfy a)
else if matching o b
@@ -330,15 +331,9 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
withOS
:: (SingI metatypes)
=> Desc
- -> (OuterMetaTypesWitness '[] -> Maybe System -> Propellor Result)
+ -> (OuterMetaTypesWitness metatypes -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
-withOS desc a = property desc $ a dummyoutermetatypes =<< getOS
- where
- -- Using this dummy value allows ensureProperty to be used
- -- even though the inner property probably doesn't target everything
- -- that the outer withOS property targets.
- dummyoutermetatypes :: OuterMetaTypesWitness ('[])
- dummyoutermetatypes = OuterMetaTypesWitness sing
+withOS desc a = property' desc $ \w -> a w =<< getOS
-- | A property that always fails with an unsupported OS error.
unsupportedOS :: Property UnixLike
diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs
index 9d49fdf4..f662c8ee 100644
--- a/src/Propellor/Property/Borg.hs
+++ b/src/Propellor/Property/Borg.hs
@@ -59,12 +59,15 @@ runBorgEnv (BorgRepoUsing os _) = map go os
go (UsesEnvVar (k, v)) = (k, v)
installed :: Property DebianLike
-installed = withOS desc $ \w o -> case o of
- (Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $
- Apt.backportInstalled ["borgbackup", "python3-msgpack"]
- _ -> ensureProperty w $
- Apt.installed ["borgbackup"]
+installed = pickOS installdebian aptinstall
where
+ installdebian :: Property Debian
+ installdebian = withOS desc $ \w o -> case o of
+ (Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $
+ Apt.backportInstalled ["borgbackup", "python3-msgpack"]
+ _ -> ensureProperty w $
+ Apt.installed ["borgbackup"]
+ aptinstall = Apt.installed ["borgbackup"] `describe` desc
desc = "installed borgbackup"
repoExists :: BorgRepo -> IO Bool
diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs
index ab700a9d..b9fb10e0 100644
--- a/src/Propellor/Property/Cron.hs
+++ b/src/Propellor/Property/Cron.hs
@@ -79,7 +79,7 @@ niceJob desc times user cddir command = job desc times user cddir
("nice ionice -c 3 sh -c " ++ shellEscape command)
-- | Installs a cron job to run propellor.
-runPropellor :: Times -> Property UnixLike
+runPropellor :: Times -> Property DebianLike
runPropellor times = withOS "propellor cron job" $ \w o -> do
bootstrapper <- getBootstrapper
ensureProperty w $
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 8a9f913b..2805cc97 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -140,7 +140,7 @@ stackAutoBuilder suite arch flavor =
-- Workaround https://github.com/commercialhaskell/stack/issues/2093
& Apt.installed ["libtinfo-dev"]
-stackInstalled :: Property Linux
+stackInstalled :: Property DebianLike
stackInstalled = withOS "stack installed" $ \w o ->
case o of
(Just (System (Debian Linux (Stable "jessie")) arch)) ->
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index d6dabdd2..07787705 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -1032,13 +1032,17 @@ homePower user hosts ctx sshkey = propertyList "home power" $ props
-- rsync server command to be updated too.
rsynccommand = "rsync -e 'ssh -i" ++ sshkeyfile ++ "' -avz rrds/ joey@kitenet.net:/srv/web/homepower.joeyh.name/rrds/"
+homerouterWifiInterfaceOld :: String
+homerouterWifiInterfaceOld = "wlx00c0ca82eb78" -- thinkpenguin wifi adapter
+
homerouterWifiInterface :: String
-homerouterWifiInterface = "wlx7cdd90400448" -- wifi dongle
+homerouterWifiInterface = "wlx7cdd90400448" -- small wifi dongle
-- My home router, running hostapd and dnsmasq,
-- with eth0 connected to a satellite modem, and a fallback ppp connection.
homeRouter :: Property (HasInfo + DebianLike)
homeRouter = propertyList "home router" $ props
+ & File.notPresent (Network.interfaceDFile homerouterWifiInterfaceOld)
& Network.static homerouterWifiInterface (IPv4 "10.1.1.1") Nothing
`requires` Network.cleanInterfacesFile
& Apt.installed ["hostapd"]
@@ -1150,6 +1154,8 @@ laptopSoftware = Apt.installed
, "yeahconsole", "xkbset", "xinput"
, "assword", "pumpa"
, "vorbis-tools", "audacity"
+ , "ekiga"
+ , "bluez-firmware", "blueman", "pulseaudio-module-bluetooth"
, "xul-ext-ublock-origin", "xul-ext-pdf.js", "xul-ext-status4evar"
, "vim-syntastic", "vim-fugitive"
, "adb", "gthumb"
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index cb63ff5a..9c9f5914 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -204,13 +204,18 @@ killUserProcesses = set "yes" <!> set "no"
-- | Ensures machined and machinectl are installed
machined :: Property Linux
-machined = withOS "machined installed" $ \w o ->
- case o of
- -- Split into separate debian package since systemd 225.
- (Just (System (Debian _ suite) _))
- | not (isStable suite) || suite == (Stable "stretch") ->
- ensureProperty w $ Apt.installed ["systemd-container"]
- _ -> noChange
+machined = installeddebian `pickOS` assumeinstalled
+ where
+ installeddebian :: Property DebianLike
+ installeddebian = withOS "machined installed" $ \w o ->
+ case o of
+ -- Split into separate debian package since systemd 225.
+ (Just (System (Debian _ suite) _))
+ | not (isStable suite) || suite == (Stable "stretch") ->
+ ensureProperty w $ Apt.installed ["systemd-container"]
+ _ -> noChange
+ assumeinstalled :: Property Linux
+ assumeinstalled = doNothing
-- | Defines a container with a given machine name,
-- and how to create its chroot if not already present.
diff --git a/src/Propellor/Utilities.hs b/src/Propellor/Utilities.hs
index 33af4eda..56e7f2fb 100644
--- a/src/Propellor/Utilities.hs
+++ b/src/Propellor/Utilities.hs
@@ -9,19 +9,27 @@
module Propellor.Utilities (
module Utility.PartialPrelude
, module Utility.Process
+ , module Utility.Process.Transcript
, module Utility.Exception
, module Utility.Env
+ , module Utility.Env.Set
, module Utility.Directory
+ , module Utility.Directory.TestDirectory
, module Utility.Tmp
+ , module Utility.Tmp.Dir
, module Utility.Monad
, module Utility.Misc
) where
import Utility.PartialPrelude
import Utility.Process
+import Utility.Process.Transcript
import Utility.Exception
import Utility.Env
+import Utility.Env.Set
import Utility.Directory
+import Utility.Directory.TestDirectory
import Utility.Tmp
+import Utility.Tmp.Dir
import Utility.Monad
import Utility.Misc