summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-03-30 19:10:32 -0400
committerJoey Hess2014-03-30 19:10:32 -0400
commit61d8214d9d8cea6ba047d1a26f9edc1ea180234b (patch)
tree1e9f0184af88eed1dd5974bf2f47b0765c23b321
parent4e442f4bcf04a68f638393d180ac7664ddd0fe4b (diff)
propellor spin
-rw-r--r--CmdLine.hs100
-rw-r--r--Common.hs3
-rw-r--r--HostName.hs18
-rw-r--r--Propellor.hs5
-rw-r--r--Property.hs19
-rw-r--r--Property/Cmd.hs2
-rw-r--r--Property/Hostname.hs2
-rw-r--r--Property/User.hs10
-rw-r--r--README19
-rw-r--r--Types.hs22
-rw-r--r--Utility/FileMode.hs155
-rw-r--r--Utility/PartialPrelude.hs68
-rw-r--r--privdata/clam.kitenet.net.gpg19
-rw-r--r--propellor.cabal3
14 files changed, 398 insertions, 47 deletions
diff --git a/CmdLine.hs b/CmdLine.hs
new file mode 100644
index 00000000..6fc99c3c
--- /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 10594d3c..bcf3283d 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 2cc50ea9..00000000
--- 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 421df2c4..01671786 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 95a225c9..e83c75de 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 c78adaeb..b29a12b3 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 3d9d2ad0..204ff5d4 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 58bfa37a..dcbf56c9 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 6a1631e3..34376263 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 00000000..d22bd171
--- /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 00000000..26692b3b
--- /dev/null
+++ b/Utility/FileMode.hs
@@ -0,0 +1,155 @@
+{- File mode utilities.
+ -
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
+ -
+ - 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 00000000..6efa093f
--- /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 00000000..9573946e
--- /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 fd5280f4..eebb4f04 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