From 61d8214d9d8cea6ba047d1a26f9edc1ea180234b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Mar 2014 19:10:32 -0400 Subject: [PATCH] propellor spin --- CmdLine.hs | 100 ++++++++++++++++++++++ Common.hs | 3 + HostName.hs | 18 ---- Propellor.hs | 5 +- Property.hs | 19 +---- Property/Cmd.hs | 2 +- Property/Hostname.hs | 2 - Property/User.hs | 10 ++- README | 19 ++++- Types.hs | 22 +++++ Utility/FileMode.hs | 155 ++++++++++++++++++++++++++++++++++ Utility/PartialPrelude.hs | 68 +++++++++++++++ privdata/clam.kitenet.net.gpg | 19 +++++ propellor.cabal | 3 +- 14 files changed, 398 insertions(+), 47 deletions(-) create mode 100644 CmdLine.hs delete mode 100644 HostName.hs create mode 100644 Types.hs create mode 100644 Utility/FileMode.hs create mode 100644 Utility/PartialPrelude.hs create mode 100644 privdata/clam.kitenet.net.gpg diff --git a/CmdLine.hs b/CmdLine.hs new file mode 100644 index 0000000..6fc99c3 --- /dev/null +++ b/CmdLine.hs @@ -0,0 +1,100 @@ +module CmdLine where + +import System.Environment +import Data.List +import System.Exit + +import Common +import Utility.FileMode + +data CmdLine + = Run HostName + | Spin HostName + | Boot HostName + | Set HostName PrivDataField String + +processCmdLine :: IO CmdLine +processCmdLine = go =<< getArgs + where + go ("--help":_) = usage + go ("--spin":h:[]) = return $ Spin h + go ("--boot":h:[]) = return $ Boot h + go ("--set":h:f:v:[]) = case readish f of + Just pf -> return $ Set h pf v + Nothing -> error $ "Unknown privdata field " ++ f + go (h:[]) = return $ Run h + go [] = do + s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"] + if null s + then error "Cannot determine hostname! Pass it on the command line." + else return $ Run s + go _ = usage + +usage :: IO a +usage = do + putStrLn $ unlines + [ "Usage:" + , " propellor" + , " propellor hostname" + , " propellor --spin hostname" + , " propellor --set hostname field value" + ] + exitFailure + +defaultMain :: (HostName -> [Property]) -> IO () +defaultMain getprops = go =<< processCmdLine + where + go (Run host) = ensureProperties (getprops host) + go (Spin host) = spin host + go (Boot host) = boot (getprops host) + go (Set host field val) = setPrivData host field val + +spin :: HostName -> IO () +spin host = do + url <- getUrl + privdata <- gpgDecrypt (privDataFile host) + void $ boolSystem "git" [Param "commit", Param "-a", Param "-m", Param "propellor spin"] + withHandle StdinHandle createProcessSuccess + (proc "ssh" ["root@"++host, bootstrap url]) $ \h -> do + hPutStr h $ unlines $ map (privDataMarker ++) $ lines privdata + hClose h + where + bootstrap url = shellWrap $ intercalate " && " + [ intercalate " ; " + [ "if [ ! -d " ++ localdir ++ " ]" + , "then" + , intercalate " && " + [ "apt-get -y install git" + , "git clone " ++ url ++ " " ++ localdir + ] + , "fi" + ] + , "cd " ++ localdir + , "make pull build" + , "./propellor --boot " ++ host + ] + +boot :: [Property] -> IO () +boot props = do + privdata <- map (drop $ length privDataMarker ) + . filter (privDataMarker `isPrefixOf`) + . lines + <$> getContents + writeFileProtected privDataLocal (unlines privdata) + ensureProperties props + +localdir :: FilePath +localdir = "/usr/local/propellor" + +getUrl :: IO String +getUrl = fromMaybe nourl <$> getM get urls + where + urls = ["remote.deploy.url", "remote.origin.url"] + nourl = error $ "Cannot find deploy url in " ++ show urls + get u = do + v <- catchMaybeIO $ + takeWhile (/= '\n') + <$> readProcess "git" ["config", u] + return $ case v of + Just url | not (null url) -> Just url + _ -> Nothing diff --git a/Common.hs b/Common.hs index 10594d3..bcf3283 100644 --- a/Common.hs +++ b/Common.hs @@ -1,8 +1,11 @@ module Common (module X) where +import Types as X import Property as X import Property.Cmd as X +import PrivData as X +import Utility.PartialPrelude as X import Control.Applicative as X import Control.Monad as X import Utility.Process as X diff --git a/HostName.hs b/HostName.hs deleted file mode 100644 index 2cc50ea..0000000 --- a/HostName.hs +++ /dev/null @@ -1,18 +0,0 @@ -module HostName where - -import Control.Applicative -import System.Environment - -import Utility.Process - -type HostName = String - -getHostName :: IO HostName -getHostName = go =<< getArgs - where - go (h:_) = return h - go [] = do - s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"] - if null s - then error "Cannot determine hostname! Pass it on the command line." - else return s diff --git a/Propellor.hs b/Propellor.hs index 421df2c..0167178 100644 --- a/Propellor.hs +++ b/Propellor.hs @@ -1,5 +1,5 @@ import Common -import HostName +import CmdLine import qualified Property.File as File import qualified Property.Apt as Apt import qualified Property.Ssh as Ssh @@ -10,7 +10,7 @@ import qualified Property.Tor as Tor import qualified Property.GitHome as GitHome main :: IO () -main = ensureProperties . getProperties =<< getHostName +main = defaultMain getProperties {- This is where the system's HostName, either as returned by uname - or one specified on the command line, is converted into a list of @@ -21,6 +21,7 @@ getProperties hostname@"clam.kitenet.net" = , standardSystem Apt.Unstable -- Clam is a tor bridge. , Tor.isBridge + , Apt.installed ["docker.io"] -- This is not an important system so I don't want to need to -- manually upgrade it. , Apt.unattendedUpgrades True diff --git a/Property.hs b/Property.hs index 95a225c..e83c75d 100644 --- a/Property.hs +++ b/Property.hs @@ -6,27 +6,10 @@ import System.Console.ANSI import System.Exit import System.IO +import Types import Utility.Monad import Utility.Exception -data Property = Property - { propertyDesc :: Desc - -- must be idempotent; may run repeatedly - , propertySatisfy :: IO Result - } - -type Desc = String - -data Result = NoChange | MadeChange | FailedChange - deriving (Show, Eq) - -combineResult :: Result -> Result -> Result -combineResult FailedChange _ = FailedChange -combineResult _ FailedChange = FailedChange -combineResult MadeChange _ = MadeChange -combineResult _ MadeChange = MadeChange -combineResult NoChange NoChange = NoChange - makeChange :: IO () -> IO Result makeChange a = a >> return MadeChange diff --git a/Property/Cmd.hs b/Property/Cmd.hs index c78adae..b29a12b 100644 --- a/Property/Cmd.hs +++ b/Property/Cmd.hs @@ -6,7 +6,7 @@ module Property.Cmd ( import Control.Applicative -import Property +import Types import Utility.Monad import Utility.SafeCommand import Utility.Env diff --git a/Property/Hostname.hs b/Property/Hostname.hs index 3d9d2ad..204ff5d 100644 --- a/Property/Hostname.hs +++ b/Property/Hostname.hs @@ -3,8 +3,6 @@ module Property.Hostname where import Common import qualified Property.File as File -type HostName = String - set :: HostName -> Property set hostname = "/etc/hostname" `File.hasContent` [hostname] `onChange` cmdProperty "hostname" [Param hostname] diff --git a/Property/User.hs b/Property/User.hs index 58bfa37..dcbf56c 100644 --- a/Property/User.hs +++ b/Property/User.hs @@ -4,8 +4,6 @@ import System.Posix import Common -type UserName = String - data Eep = YesReallyDeleteHome sshAccountFor :: UserName -> Property @@ -24,6 +22,14 @@ nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel" ] `describe` ("nuked user " ++ user) +setPassword :: UserName -> Property +setPassword user = Property (user ++ " password set") $ + withPrivData (Password user) $ \password -> makeChange $ + withHandle StdinHandle createProcessSuccess + (proc "chpasswd" []) $ \h -> do + hPutStrLn h $ user ++ ":" ++ password + hClose h + lockedPassword :: UserName -> Property lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd" [ Param "--lock" diff --git a/README b/README index 6a1631e..3437626 100644 --- a/README +++ b/README @@ -11,9 +11,6 @@ to a system, and "make" can be used to pull down any new changes, and compile and run propellor. This can be done by a cron job. Or something can ssh in and run it. -For bootstrapping, propellor compiles to a single binary file, -which can be transferred to a host and run. - Properties are defined using Haskell. Edit Propellor.hs There is no special language as used in puppet, chef, ansible, etc, just @@ -26,4 +23,20 @@ of which classes and share which configuration. It might be nice to use reclass[1], but then again a host is configured using simply haskell code, and so it's easy to factor out things like classes of hosts as desired. +To bootstrap propellor on a new host, use: propellor --spin $host +This looks up the git repository's remote.origin.url (or remote.deploy.url +if available) and logs into the host, clones the url (if not already +done), and sets up and runs propellor in /usr/local/propellor + +Private data such as passwords, ssh private keys, etc should not be checked +into a propellor git repository in the clear, unless you want to restrict +access to the repository. Which would probably involve a separate fork +for each host and be annoying. + +Instead, propellor --spin $host looks for a privdata/$host.gpg file and +if found decrypts it and sends it to the host using ssh. To set a field +in such a file, use: propellor --set $host $field $value +The field name is will be something like 'Password "root"'; see PrivData.hs +for available fields. + [1] http://reclass.pantsfullofunix.net/ diff --git a/Types.hs b/Types.hs new file mode 100644 index 0000000..d22bd17 --- /dev/null +++ b/Types.hs @@ -0,0 +1,22 @@ +module Types where + +type HostName = String +type UserName = String + +data Property = Property + { propertyDesc :: Desc + -- must be idempotent; may run repeatedly + , propertySatisfy :: IO Result + } + +type Desc = String + +data Result = NoChange | MadeChange | FailedChange + deriving (Show, Eq) + +combineResult :: Result -> Result -> Result +combineResult FailedChange _ = FailedChange +combineResult _ FailedChange = FailedChange +combineResult MadeChange _ = MadeChange +combineResult _ MadeChange = MadeChange +combineResult NoChange NoChange = NoChange diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs new file mode 100644 index 0000000..26692b3 --- /dev/null +++ b/Utility/FileMode.hs @@ -0,0 +1,155 @@ +{- File mode utilities. + - + - Copyright 2010-2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Utility.FileMode where + +import System.IO +import Control.Monad +import Control.Exception (bracket) +import System.PosixCompat.Types +#ifndef mingw32_HOST_OS +import System.Posix.Files +#endif +import Foreign (complement) + +import Utility.Exception + +{- Applies a conversion function to a file's mode. -} +modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO () +modifyFileMode f convert = void $ modifyFileMode' f convert +modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode +modifyFileMode' f convert = do + s <- getFileStatus f + let old = fileMode s + let new = convert old + when (new /= old) $ + setFileMode f new + return old + +{- Adds the specified FileModes to the input mode, leaving the rest + - unchanged. -} +addModes :: [FileMode] -> FileMode -> FileMode +addModes ms m = combineModes (m:ms) + +{- Removes the specified FileModes from the input mode. -} +removeModes :: [FileMode] -> FileMode -> FileMode +removeModes ms m = m `intersectFileModes` complement (combineModes ms) + +{- Runs an action after changing a file's mode, then restores the old mode. -} +withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a +withModifiedFileMode file convert a = bracket setup cleanup go + where + setup = modifyFileMode' file convert + cleanup oldmode = modifyFileMode file (const oldmode) + go _ = a + +writeModes :: [FileMode] +writeModes = [ownerWriteMode, groupWriteMode, otherWriteMode] + +readModes :: [FileMode] +readModes = [ownerReadMode, groupReadMode, otherReadMode] + +executeModes :: [FileMode] +executeModes = [ownerExecuteMode, groupExecuteMode, otherExecuteMode] + +{- Removes the write bits from a file. -} +preventWrite :: FilePath -> IO () +preventWrite f = modifyFileMode f $ removeModes writeModes + +{- Turns a file's owner write bit back on. -} +allowWrite :: FilePath -> IO () +allowWrite f = modifyFileMode f $ addModes [ownerWriteMode] + +{- Turns a file's owner read bit back on. -} +allowRead :: FilePath -> IO () +allowRead f = modifyFileMode f $ addModes [ownerReadMode] + +{- Allows owner and group to read and write to a file. -} +groupSharedModes :: [FileMode] +groupSharedModes = + [ ownerWriteMode, groupWriteMode + , ownerReadMode, groupReadMode + ] + +groupWriteRead :: FilePath -> IO () +groupWriteRead f = modifyFileMode f $ addModes groupSharedModes + +checkMode :: FileMode -> FileMode -> Bool +checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor + +{- Checks if a file mode indicates it's a symlink. -} +isSymLink :: FileMode -> Bool +#ifdef mingw32_HOST_OS +isSymLink _ = False +#else +isSymLink = checkMode symbolicLinkMode +#endif + +{- Checks if a file has any executable bits set. -} +isExecutable :: FileMode -> Bool +isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0 + +{- Runs an action without that pesky umask influencing it, unless the + - passed FileMode is the standard one. -} +noUmask :: FileMode -> IO a -> IO a +#ifndef mingw32_HOST_OS +noUmask mode a + | mode == stdFileMode = a + | otherwise = withUmask nullFileMode a +#else +noUmask _ a = a +#endif + +withUmask :: FileMode -> IO a -> IO a +#ifndef mingw32_HOST_OS +withUmask umask a = bracket setup cleanup go + where + setup = setFileCreationMask umask + cleanup = setFileCreationMask + go _ = a +#else +withUmask _ a = a +#endif + +combineModes :: [FileMode] -> FileMode +combineModes [] = undefined +combineModes [m] = m +combineModes (m:ms) = foldl unionFileModes m ms + +isSticky :: FileMode -> Bool +#ifdef mingw32_HOST_OS +isSticky _ = False +#else +isSticky = checkMode stickyMode + +stickyMode :: FileMode +stickyMode = 512 + +setSticky :: FilePath -> IO () +setSticky f = modifyFileMode f $ addModes [stickyMode] +#endif + +{- Writes a file, ensuring that its modes do not allow it to be read + - or written by anyone other than the current user, + - before any content is written. + - + - When possible, this is done using the umask. + - + - On a filesystem that does not support file permissions, this is the same + - as writeFile. + -} +writeFileProtected :: FilePath -> String -> IO () +writeFileProtected file content = withUmask 0o0077 $ + withFile file WriteMode $ \h -> do + void $ tryIO $ modifyFileMode file $ + removeModes + [ groupReadMode, otherReadMode + , groupWriteMode, otherWriteMode + ] + hPutStr h content diff --git a/Utility/PartialPrelude.hs b/Utility/PartialPrelude.hs new file mode 100644 index 0000000..6efa093 --- /dev/null +++ b/Utility/PartialPrelude.hs @@ -0,0 +1,68 @@ +{- Parts of the Prelude are partial functions, which are a common source of + - bugs. + - + - This exports functions that conflict with the prelude, which avoids + - them being accidentially used. + -} + +module Utility.PartialPrelude where + +import qualified Data.Maybe + +{- read should be avoided, as it throws an error + - Instead, use: readish -} +read :: Read a => String -> a +read = Prelude.read + +{- head is a partial function; head [] is an error + - Instead, use: take 1 or headMaybe -} +head :: [a] -> a +head = Prelude.head + +{- tail is also partial + - Instead, use: drop 1 -} +tail :: [a] -> [a] +tail = Prelude.tail + +{- init too + - Instead, use: beginning -} +init :: [a] -> [a] +init = Prelude.init + +{- last too + - Instead, use: end or lastMaybe -} +last :: [a] -> a +last = Prelude.last + +{- Attempts to read a value from a String. + - + - Ignores leading/trailing whitespace, and throws away any trailing + - text after the part that can be read. + - + - readMaybe is available in Text.Read in new versions of GHC, + - but that one requires the entire string to be consumed. + -} +readish :: Read a => String -> Maybe a +readish s = case reads s of + ((x,_):_) -> Just x + _ -> Nothing + +{- Like head but Nothing on empty list. -} +headMaybe :: [a] -> Maybe a +headMaybe = Data.Maybe.listToMaybe + +{- Like last but Nothing on empty list. -} +lastMaybe :: [a] -> Maybe a +lastMaybe [] = Nothing +lastMaybe v = Just $ Prelude.last v + +{- All but the last element of a list. + - (Like init, but no error on an empty list.) -} +beginning :: [a] -> [a] +beginning [] = [] +beginning l = Prelude.init l + +{- Like last, but no error on an empty list. -} +end :: [a] -> [a] +end [] = [] +end l = [Prelude.last l] diff --git a/privdata/clam.kitenet.net.gpg b/privdata/clam.kitenet.net.gpg new file mode 100644 index 0000000..9573946 --- /dev/null +++ b/privdata/clam.kitenet.net.gpg @@ -0,0 +1,19 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v1 + +hQIMA7ODiaEXBlRZAQ//V77CfPgJXpqO0W3F41MaSV/sa1PIoB9B/JsLGog+2ZGW +sbLevCdlQNoWwmzuBzDBsAdIDgsAQX3o5ldqOaJ6jZSc0AVUUE6QQQ6ggCz5kCre +/JU/7YXTthmQv/9zu1tGeX7tjIaHQBkihq+3lS0TQjQqVBQmZJBJjgL+wZJ0fshF +T+hrCBi5s9DS/YIGoghpuQVJ0yA16fU7aLaH5jaF0CEsRm8Q+Qvn4v+1YlEi+d7t +Mk5AQ0YKE1kC2eIA8TjK1hIF/4NEEY/wnonJTcAhJ6op4gqjmhhQ/sXwaobg8UmQ +vew4q3+wiYpLdTGbYMfI3pNV2FpltZXg8DLKjxZFH6H/0cL5xZDG7ZiDJh6hyHJN +unpjgLm0UxvSLb/Jp4vycycP8SXz+XSo1ZhQDq8Qof1Sg5LBSXdzouM1xSX+kPqm ++0C9eabqNCG7deVDDQe9V25+CUIVMM70WavtRRICwNrUZCrChCO85gMZPzpYYYr2 ++3z+ygPw8s41waCBPH6EH+9Qw5PmIyqBYoFbnPNY8g2hmu2oFlEcN7REzYduZL3D +MNRahF/l40Ek4l3TYDI4OPyIqRb8sCifZTphyjhIULlTGlfuO4gwRiHIdssSpH7t +TjhcgJfqBPSmyq4oIRUUxoBwMsaL9OunFi+7pHInbGksLY7Lfv07P3WpBdYjlwXS +cgGqVY+WDTMvde+LYu459OkZW80VH+WgJb7NWpRiFqJyTyOtqeLIT+33/noO4f4y +VYRb94zsB4n8u3tZfIFAGj2G6pbJPMhyEvST6ePkL0q63rC+BjwsQ0Q7wXVPLqMu +mxr+K75/DTbP5ft8gmY80sDrHQ== +=vDG9 +-----END PGP MESSAGE----- diff --git a/propellor.cabal b/propellor.cabal index fd5280f..eebb4f0 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -19,7 +19,8 @@ Executable propellor Main-Is: Propellor.hs GHC-Options: -Wall Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, - IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal + IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, + containers if (! os(windows)) Build-Depends: unix