From 8621fa6e9983a39c07a9677eac324ebcee79b549 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Mar 2014 23:55:59 -0400 Subject: more prep for hackage --- Propellor.hs | 25 +++++++++++++++++++++++++ Propellor/CmdLine.hs | 3 ++- Propellor/Common.hs | 22 ---------------------- Propellor/Property/Apt.hs | 28 ++++++++++++++-------------- Propellor/Property/Cmd.hs | 22 ++++++++++++---------- Propellor/Property/Docker.hs | 2 +- Propellor/Property/File.hs | 2 +- Propellor/Property/GitHome.hs | 3 ++- Propellor/Property/Hostname.hs | 4 ++-- Propellor/Property/JoeySites.hs | 2 +- Propellor/Property/Network.hs | 4 ++-- Propellor/Property/Reboot.hs | 2 +- Propellor/Property/Ssh.hs | 7 ++++--- Propellor/Property/Sudo.hs | 2 +- Propellor/Property/Tor.hs | 4 ++-- Propellor/Property/User.hs | 16 ++++++++-------- propellor.cabal | 2 +- propellor.hs | 4 ++-- 18 files changed, 81 insertions(+), 73 deletions(-) create mode 100644 Propellor.hs delete mode 100644 Propellor/Common.hs diff --git a/Propellor.hs b/Propellor.hs new file mode 100644 index 00000000..5ee2f860 --- /dev/null +++ b/Propellor.hs @@ -0,0 +1,25 @@ +-- | Pulls in lots of useful modules for building Properties. + +module Propellor (module X) where + +import Propellor.Types as X +import Propellor.Property as X +import Propellor.Property.Cmd as X +import Propellor.PrivData as X + +import Utility.PartialPrelude as X +import Utility.Process as X +import Utility.Exception as X +import Utility.Env as X +import Utility.Directory as X +import Utility.Tmp as X +import Utility.Monad as X +import Utility.Misc as X + +import System.Directory as X +import System.IO as X +import System.FilePath as X +import Data.Maybe as X +import Data.Either as X +import Control.Applicative as X +import Control.Monad as X diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs index b60b916e..6afa739c 100644 --- a/Propellor/CmdLine.hs +++ b/Propellor/CmdLine.hs @@ -4,8 +4,9 @@ import System.Environment import Data.List import System.Exit -import Propellor.Common +import Propellor import Utility.FileMode +import Utility.SafeCommand data CmdLine = Run HostName diff --git a/Propellor/Common.hs b/Propellor/Common.hs deleted file mode 100644 index 3a085540..00000000 --- a/Propellor/Common.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Propellor.Common (module X) where - -import Propellor.Types as X -import Propellor.Property as X -import Propellor.Property.Cmd as X -import Propellor.PrivData as X - -import Utility.PartialPrelude as X -import Control.Applicative as X -import Control.Monad as X -import Utility.Process as X -import System.Directory as X -import System.IO as X -import Utility.Exception as X -import Utility.Env as X -import Utility.Directory as X -import Utility.Tmp as X -import System.FilePath as X -import Data.Maybe as X -import Data.Either as X -import Utility.Monad as X -import Utility.Misc as X diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs index a7d50408..c91415e1 100644 --- a/Propellor/Property/Apt.hs +++ b/Propellor/Property/Apt.hs @@ -6,7 +6,7 @@ import Data.List import System.IO import Control.Monad -import Propellor.Common +import Propellor import qualified Propellor.Property.File as File import Propellor.Property.File (Line) @@ -51,7 +51,7 @@ stdSourcesList suite = setSourcesList (debCdn suite) setSourcesList :: [Line] -> Property setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update -runApt :: [CommandParam] -> Property +runApt :: [String] -> Property runApt ps = cmdProperty' "apt-get" ps env where env = @@ -60,11 +60,11 @@ runApt ps = cmdProperty' "apt-get" ps env ] update :: Property -update = runApt [Param "update"] +update = runApt ["update"] `describe` "apt update" upgrade :: Property -upgrade = runApt [Params "-y dist-upgrade"] +upgrade = runApt ["-y", "dist-upgrade"] `describe` "apt dist-upgrade" type Package = String @@ -73,13 +73,13 @@ installed :: [Package] -> Property installed ps = check (isInstallable ps) go `describe` (unwords $ "apt installed":ps) where - go = runApt $ [Param "-y", Param "install"] ++ map Param ps + go = runApt $ ["-y", "install"] ++ ps removed :: [Package] -> Property removed ps = check (or <$> isInstalled' ps) go `describe` (unwords $ "apt removed":ps) where - go = runApt $ [Param "-y", Param "remove"] ++ map Param ps + go = runApt $ ["-y", "remove"] ++ ps isInstallable :: [Package] -> IO Bool isInstallable ps = do @@ -89,10 +89,10 @@ isInstallable ps = do isInstalled :: Package -> IO Bool isInstalled p = (== [True]) <$> isInstalled' [p] -{- | Note that the order of the returned list will not always - - correspond to the order of the input list. The number of items may - - even vary. If apt does not know about a package at all, it will not - - be included in the result list. -} +-- | Note that the order of the returned list will not always +-- correspond to the order of the input list. The number of items may +-- even vary. If apt does not know about a package at all, it will not +-- be included in the result list. isInstalled' :: [Package] -> IO [Bool] isInstalled' ps = catMaybes . map parse . lines <$> readProcess "apt-cache" ("policy":ps) @@ -103,7 +103,7 @@ isInstalled' ps = catMaybes . map parse . lines | otherwise = Nothing autoRemove :: Property -autoRemove = runApt [Param "-y", Param "autoremove"] +autoRemove = runApt ["-y", "autoremove"] `describe` "apt autoremove" unattendedUpgrades :: Bool -> Property @@ -117,8 +117,8 @@ unattendedUpgrades enabled = | enabled = "true" | otherwise = "false" -{- | Preseeds debconf values and reconfigures the package so it takes - - effect. -} +-- | Preseeds debconf values and reconfigures the package so it takes +-- effect. reConfigure :: Package -> [(String, String, String)] -> Property reConfigure package vals = reconfigure `requires` setselections `describe` ("reconfigure " ++ package) @@ -129,4 +129,4 @@ reConfigure package vals = reconfigure `requires` setselections forM_ vals $ \(template, tmpltype, value) -> hPutStrLn h $ unwords [package, template, tmpltype, value] hClose h - reconfigure = cmdProperty "dpkg-reconfigure" [Param "-fnone", Param package] + reconfigure = cmdProperty "dpkg-reconfigure" ["-fnone", package] diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs index 6e23955c..88a84968 100644 --- a/Propellor/Property/Cmd.hs +++ b/Propellor/Property/Cmd.hs @@ -1,8 +1,7 @@ module Propellor.Property.Cmd ( cmdProperty, cmdProperty', - scriptProperty, - module Utility.SafeCommand + scriptProperty ) where import Control.Applicative @@ -13,23 +12,26 @@ import Utility.Monad import Utility.SafeCommand import Utility.Env -cmdProperty :: String -> [CommandParam] -> Property +-- | A property that can be satisfied by running a command. +-- +-- The command must exit 0 on success. +cmdProperty :: String -> [String] -> Property cmdProperty cmd params = cmdProperty' cmd params [] -cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property +-- | A property that can be satisfied by running a command, +-- with added environment. +cmdProperty' :: String -> [String] -> [(String, String)] -> Property cmdProperty' cmd params env = Property desc $ do env' <- addEntries env <$> getEnvironment - ifM (boolSystemEnv cmd params (Just env')) + ifM (boolSystemEnv cmd (map Param params) (Just env')) ( return MadeChange , return FailedChange ) where - desc = unwords $ cmd : map showp params - showp (Params s) = s - showp (Param s) = s - showp (File s) = s + desc = unwords $ cmd : params +-- | A property that can be satisfied by running a series of shell commands. scriptProperty :: [String] -> Property -scriptProperty script = cmdProperty "sh" [Param "-c", Param shellcmd] +scriptProperty script = cmdProperty "sh" ["-c", shellcmd] where shellcmd = intercalate " ; " ("set -e" : script) diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index 744feb42..43c78d85 100644 --- a/Propellor/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -1,6 +1,6 @@ module Propellor.Property.Docker where -import Propellor.Common +import Propellor import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs index 082542e9..befcc59d 100644 --- a/Propellor/Property/File.hs +++ b/Propellor/Property/File.hs @@ -1,6 +1,6 @@ module Propellor.Property.File where -import Propellor.Common +import Propellor type Line = String diff --git a/Propellor/Property/GitHome.hs b/Propellor/Property/GitHome.hs index 400586e2..593aecd5 100644 --- a/Propellor/Property/GitHome.hs +++ b/Propellor/Property/GitHome.hs @@ -1,8 +1,9 @@ module Propellor.Property.GitHome where -import Propellor.Common +import Propellor import qualified Propellor.Property.Apt as Apt import Propellor.Property.User +import Utility.SafeCommand {- | Clones Joey Hess's git home directory, and runs its fixups script. -} installedFor :: UserName -> Property diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs index 8daf6bb2..25f0e1b2 100644 --- a/Propellor/Property/Hostname.hs +++ b/Propellor/Property/Hostname.hs @@ -1,9 +1,9 @@ module Propellor.Property.Hostname where -import Propellor.Common +import Propellor import qualified Propellor.Property.File as File set :: HostName -> Property set hostname = "/etc/hostname" `File.hasContent` [hostname] - `onChange` cmdProperty "hostname" [Param hostname] + `onChange` cmdProperty "hostname" [hostname] `describe` ("hostname " ++ hostname) diff --git a/Propellor/Property/JoeySites.hs b/Propellor/Property/JoeySites.hs index e862916d..d92edb88 100644 --- a/Propellor/Property/JoeySites.hs +++ b/Propellor/Property/JoeySites.hs @@ -3,7 +3,7 @@ module Propellor.Property.JoeySites where -import Propellor.Common +import Propellor import qualified Propellor.Property.Apt as Apt oldUseNetshellBox :: Property diff --git a/Propellor/Property/Network.hs b/Propellor/Property/Network.hs index 704455b0..cbef8baa 100644 --- a/Propellor/Property/Network.hs +++ b/Propellor/Property/Network.hs @@ -1,6 +1,6 @@ module Propellor.Property.Network where -import Propellor.Common +import Propellor import Propellor.Property.File interfaces :: FilePath @@ -24,4 +24,4 @@ ipv6to4 = fileProperty "ipv6to4" go interfaces ] ifUp :: String -> Property -ifUp iface = cmdProperty "ifup" [Param iface] +ifUp iface = cmdProperty "ifup" [iface] diff --git a/Propellor/Property/Reboot.hs b/Propellor/Property/Reboot.hs index 1a419d60..25e53159 100644 --- a/Propellor/Property/Reboot.hs +++ b/Propellor/Property/Reboot.hs @@ -1,6 +1,6 @@ module Propellor.Property.Reboot where -import Propellor.Common +import Propellor now :: Property now = cmdProperty "reboot" [] diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs index 39e02689..2c2c54c8 100644 --- a/Propellor/Property/Ssh.hs +++ b/Propellor/Property/Ssh.hs @@ -1,8 +1,9 @@ module Propellor.Property.Ssh where -import Propellor.Common +import Propellor import qualified Propellor.Property.File as File import Propellor.Property.User +import Utility.SafeCommand sshBool :: Bool -> String sshBool True = "yes" @@ -35,7 +36,7 @@ hasAuthorizedKeys = go <=< homedir (readFile $ home ".ssh" "authorized_keys") restartSshd :: Property -restartSshd = cmdProperty "service" [Param "ssh", Param "restart"] +restartSshd = cmdProperty "service" ["ssh", "restart"] {- | Blow away existing host keys and make new ones. Use a flag - file to prevent doing this more than once. -} @@ -50,4 +51,4 @@ uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" ] ensureProperty $ cmdProperty "/var/lib/dpkg/info/openssh-server.postinst" - [Param "configure"] + ["configure"] diff --git a/Propellor/Property/Sudo.hs b/Propellor/Property/Sudo.hs index 05484411..dbb3e460 100644 --- a/Propellor/Property/Sudo.hs +++ b/Propellor/Property/Sudo.hs @@ -2,7 +2,7 @@ module Propellor.Property.Sudo where import Data.List -import Propellor.Common +import Propellor import Propellor.Property.File import qualified Propellor.Property.Apt as Apt import Propellor.Property.User diff --git a/Propellor/Property/Tor.hs b/Propellor/Property/Tor.hs index aa5d29e4..78e35c89 100644 --- a/Propellor/Property/Tor.hs +++ b/Propellor/Property/Tor.hs @@ -1,6 +1,6 @@ module Propellor.Property.Tor where -import Propellor.Common +import Propellor import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt @@ -16,4 +16,4 @@ isBridge = setup `requires` Apt.installed ["tor"] ] `onChange` restartTor restartTor :: Property -restartTor = cmdProperty "service" [Param "tor", Param "restart"] +restartTor = cmdProperty "service" ["tor", "restart"] diff --git a/Propellor/Property/User.hs b/Propellor/Property/User.hs index 2d2118cc..5a23f72d 100644 --- a/Propellor/Property/User.hs +++ b/Propellor/Property/User.hs @@ -2,23 +2,23 @@ module Propellor.Property.User where import System.Posix -import Propellor.Common +import Propellor data Eep = YesReallyDeleteHome sshAccountFor :: UserName -> Property sshAccountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser" - [ Param "--disabled-password" - , Param "--gecos", Param "" - , Param user + [ "--disabled-password" + , "--gecos", "" + , user ] `describe` ("ssh account " ++ user) {- | Removes user home directory!! Use with caution. -} nuked :: UserName -> Eep -> Property nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel" - [ Param "-r" - , Param user + [ "-r" + , user ] `describe` ("nuked user " ++ user) @@ -38,8 +38,8 @@ hasPassword user = Property (user ++ " has password") $ lockedPassword :: UserName -> Property lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd" - [ Param "--lock" - , Param user + [ "--lock" + , user ] `describe` ("locked " ++ user ++ " password") diff --git a/propellor.cabal b/propellor.cabal index f78874bf..25a6f29b 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -43,6 +43,7 @@ Library Build-Depends: unix Exposed-Modules: + Propellor Propellor.Property Propellor.Property.Apt Propellor.Property.Cmd @@ -58,7 +59,6 @@ Library Propellor.Property.Tor Propellor.Property.User Propellor.CmdLine - Propellor.Common Propellor.PrivData Propellor.Types Other-Modules: diff --git a/propellor.hs b/propellor.hs index 695fdf82..ccfea866 100644 --- a/propellor.hs +++ b/propellor.hs @@ -1,4 +1,4 @@ -import Propellor.Common +import Propellor import Propellor.CmdLine import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt @@ -71,7 +71,7 @@ cleanCloudAtCost hostname = propertyList "cloudatcost cleanup" , "worked around grub/lvm boot bug #743126" ==> "/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true" `onChange` cmdProperty "update-grub" [] - `onChange` cmdProperty "update-initramfs" [Param "-u"] + `onChange` cmdProperty "update-initramfs" ["-u"] , "nuked cloudatcost cruft" ==> combineProperties [ File.notPresent "/etc/rc.local" , File.notPresent "/etc/init.d/S97-setup.sh" -- cgit v1.2.3