propellor spin
This commit is contained in:
Joey Hess
parent
9f781db6da
commit
58f79c12aa
|
|
@ -72,14 +72,15 @@ hosts = -- (o) `
|
|||
& Apt.buildDep ["git-annex"] `period` Daily
|
||||
|
||||
-- Important stuff that needs not too much memory or CPU.
|
||||
, standardSystem "diatom.kitenet.net" Stable "amd64"
|
||||
, let ctx = Context "diatom.kitenet.net "
|
||||
in standardSystem "diatom.kitenet.net" Stable "amd64"
|
||||
& ipv4 "107.170.31.195"
|
||||
|
||||
& DigitalOcean.distroKernel
|
||||
& Hostname.sane
|
||||
& Ssh.hostKey SshDsa
|
||||
& Ssh.hostKey SshRsa
|
||||
& Ssh.hostKey SshEcdsa
|
||||
& Ssh.hostKey SshDsa ctx
|
||||
& Ssh.hostKey SshRsa ctx
|
||||
& Ssh.hostKey SshEcdsa ctx
|
||||
& Apt.unattendedUpgrades
|
||||
& Apt.serviceInstalledRunning "ntp"
|
||||
& Postfix.satellite
|
||||
|
|
@ -89,9 +90,9 @@ hosts = -- (o) `
|
|||
& Apt.serviceInstalledRunning "swapspace"
|
||||
|
||||
& Apt.serviceInstalledRunning "apache2"
|
||||
& File.hasPrivContent "/etc/ssl/certs/web.pem"
|
||||
& File.hasPrivContent "/etc/ssl/private/web.pem"
|
||||
& File.hasPrivContent "/etc/ssl/certs/startssl.pem"
|
||||
& File.hasPrivContent "/etc/ssl/certs/web.pem" (Context "kitenet.net")
|
||||
& File.hasPrivContent "/etc/ssl/private/web.pem" (Context "kitenet.net")
|
||||
& File.hasPrivContent "/etc/ssl/certs/startssl.pem" (Context "kitenet.net")
|
||||
& Apache.modEnabled "ssl"
|
||||
& Apache.multiSSL
|
||||
& File.ownerGroup "/srv/web" "joey" "joey"
|
||||
|
|
@ -133,16 +134,17 @@ hosts = -- (o) `
|
|||
& Dns.secondaryFor ["animx"] hosts "animx.eu.org"
|
||||
|
||||
-- storage and backup server
|
||||
, standardSystem "elephant.kitenet.net" Unstable "amd64"
|
||||
, let ctx = Context "elephant.kitenet.net"
|
||||
in standardSystem "elephant.kitenet.net" Unstable "amd64"
|
||||
& ipv4 "193.234.225.114"
|
||||
|
||||
& Hostname.sane
|
||||
& Postfix.satellite
|
||||
& Apt.unattendedUpgrades
|
||||
& Ssh.hostKey SshDsa
|
||||
& Ssh.hostKey SshRsa
|
||||
& Ssh.hostKey SshEcdsa
|
||||
& Ssh.keyImported SshRsa "joey"
|
||||
& Ssh.hostKey SshDsa ctx
|
||||
& Ssh.hostKey SshRsa ctx
|
||||
& Ssh.hostKey SshEcdsa ctx
|
||||
& Ssh.keyImported SshRsa "joey" ctx
|
||||
|
||||
-- PV-grub chaining
|
||||
-- http://notes.pault.ag/linode-pv-grub-chainning/
|
||||
|
|
@ -263,13 +265,13 @@ standardSystem hn suite arch = host hn
|
|||
& Apt.installed ["etckeeper"]
|
||||
& Apt.installed ["ssh"]
|
||||
& GitHome.installedFor "root"
|
||||
& User.hasSomePassword "root"
|
||||
& User.hasSomePassword "root" (Context hn)
|
||||
-- Harden the system, but only once root's authorized_keys
|
||||
-- is safely in place.
|
||||
& check (Ssh.hasAuthorizedKeys "root")
|
||||
(Ssh.passwordAuthentication False)
|
||||
& User.accountFor "joey"
|
||||
& User.hasSomePassword "joey"
|
||||
& User.hasSomePassword "joey" (Context hn)
|
||||
& Sudo.enabledFor "joey"
|
||||
& GitHome.installedFor "joey"
|
||||
& Apt.installed ["vim", "screen", "less"]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,14 @@
|
|||
propellor (0.7.1) UNRELEASED; urgency=medium
|
||||
propellor (0.8.0) UNRELEASED; urgency=medium
|
||||
|
||||
* Completely reworked privdata storage. There is now a single file,
|
||||
and each host is sent only the privdata that its Properties actually use.
|
||||
|
||||
To transition existing privdata, run propellor against a host and
|
||||
watch out for the red failure messages, and run the suggested commands
|
||||
to store the privdata using the new storage scheme.
|
||||
|
||||
* Add --edit to edit a privdata value in $EDITOR.
|
||||
* Add --list-fields to list a host's currently set privdata fields.
|
||||
* Add --list-fields to list all currently set privdata fields.
|
||||
* Fix randomHostKeys property to run openssh-server's postinst in a
|
||||
non-failing way.
|
||||
* Hostname.sane now cleans up the 127.0.0.1 localhost line in /etc/hosts,
|
||||
|
|
|
|||
|
|
@ -27,10 +27,11 @@ Since the propoellor git repository is public, you can't store
|
|||
in cleartext private data such as passwords, ssh private keys, etc.
|
||||
|
||||
Instead, `propellor --spin $host` looks for a
|
||||
`~/.propellor/privdata/$host.gpg` file and if found decrypts it and sends
|
||||
it to the remote host using ssh. This lets a remote host know its own
|
||||
private data, without seeing all the rest.
|
||||
`~/.propellor/privdata/privdata.gpg` file and if found decrypts it,
|
||||
extracts the private that that the $host needs, and sends it to to the
|
||||
$host using ssh. This lets a host know its own private data, without
|
||||
seeing all the rest.
|
||||
|
||||
To securely store private data, use: `propellor --set $host $field`
|
||||
The field name will be something like 'Password "root"'; see PrivData.hs
|
||||
for available fields.
|
||||
To securely store private data, use: `propellor --set $field $context`
|
||||
Propellor will tell you the details when you use a Property that needs
|
||||
PrivData.
|
||||
|
|
|
|||
|
|
@ -105,6 +105,7 @@ Library
|
|||
Propellor.Types
|
||||
Propellor.Types.OS
|
||||
Propellor.Types.Dns
|
||||
Propellor.Types.PrivData
|
||||
Other-Modules:
|
||||
Propellor.Types.Info
|
||||
Propellor.CmdLine
|
||||
|
|
|
|||
|
|
@ -27,10 +27,10 @@ usage = do
|
|||
, " propellor hostname"
|
||||
, " propellor --spin hostname"
|
||||
, " propellor --add-key keyid"
|
||||
, " propellor --set hostname field"
|
||||
, " propellor --dump hostname field"
|
||||
, " propellor --edit hostname field"
|
||||
, " propellor --list-fields hostname"
|
||||
, " propellor --set field context"
|
||||
, " propellor --dump field context"
|
||||
, " propellor --edit field context"
|
||||
, " propellor --list-fields"
|
||||
]
|
||||
exitFailure
|
||||
|
||||
|
|
@ -41,10 +41,10 @@ processCmdLine = go =<< getArgs
|
|||
go ("--spin":h:[]) = return $ Spin h
|
||||
go ("--boot":h:[]) = return $ Boot h
|
||||
go ("--add-key":k:[]) = return $ AddKey k
|
||||
go ("--set":h:f:[]) = withprivfield f (return . Set h)
|
||||
go ("--dump":h:f:[]) = withprivfield f (return . Dump h)
|
||||
go ("--edit":h:f:[]) = withprivfield f (return . Edit h)
|
||||
go ("--list-fields":h:[]) = return $ ListFields h
|
||||
go ("--set":f:c:[]) = withprivfield f c Set
|
||||
go ("--dump":f:c:[]) = withprivfield f c Dump
|
||||
go ("--edit":f:c:[]) = withprivfield f c Edit
|
||||
go ("--list-fields":[]) = return ListFields
|
||||
go ("--continue":s:[]) = case readish s of
|
||||
Just cmdline -> return $ Continue cmdline
|
||||
Nothing -> errorMessage "--continue serialization failure"
|
||||
|
|
@ -60,8 +60,8 @@ processCmdLine = go =<< getArgs
|
|||
else return $ Run s
|
||||
go _ = usage
|
||||
|
||||
withprivfield s f = case readish s of
|
||||
Just pf -> f pf
|
||||
withprivfield s c f = case readish s of
|
||||
Just pf -> return $ f pf (Context c)
|
||||
Nothing -> errorMessage $ "Unknown privdata field " ++ s
|
||||
|
||||
defaultMain :: [Host] -> IO ()
|
||||
|
|
@ -73,10 +73,10 @@ defaultMain hostlist = do
|
|||
go True cmdline
|
||||
where
|
||||
go _ (Continue cmdline) = go False cmdline
|
||||
go _ (Set hn field) = setPrivData hn field
|
||||
go _ (Dump hn field) = dumpPrivData hn field
|
||||
go _ (Edit hn field) = editPrivData hn field
|
||||
go _ (ListFields hn) = listPrivDataFields hn
|
||||
go _ (Set field context) = setPrivData field context
|
||||
go _ (Dump field context) = dumpPrivData field context
|
||||
go _ (Edit field context) = editPrivData field context
|
||||
go _ ListFields = listPrivDataFields
|
||||
go _ (AddKey keyid) = addKey keyid
|
||||
go _ (Chain hn) = withhost hn $ \h -> do
|
||||
r <- runPropellor h $ ensureProperties $ hostProperties h
|
||||
|
|
@ -182,11 +182,11 @@ spin hn = do
|
|||
void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
|
||||
void $ boolSystem "git" [Param "push"]
|
||||
cacheparams <- toCommand <$> sshCachingParams hn
|
||||
go cacheparams url =<< gpgDecrypt (privDataFile hn)
|
||||
go cacheparams url =<< gpgDecrypt privDataFile
|
||||
where
|
||||
go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
|
||||
let finish = do
|
||||
senddata toh (privDataFile hn) privDataMarker privdata
|
||||
senddata toh privDataLocal privDataMarker privdata
|
||||
hClose toh
|
||||
|
||||
-- Display remaining output.
|
||||
|
|
|
|||
|
|
@ -2,18 +2,20 @@
|
|||
|
||||
module Propellor.PrivData where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Control.Applicative
|
||||
import System.FilePath
|
||||
import System.IO
|
||||
import System.Directory
|
||||
import Data.Maybe
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Control.Monad
|
||||
import Control.Monad.IfElse
|
||||
import "mtl" Control.Monad.Reader
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Propellor.Types
|
||||
import Propellor.Types.Info
|
||||
import Propellor.Message
|
||||
import Utility.Monad
|
||||
import Utility.PartialPrelude
|
||||
|
|
@ -25,40 +27,57 @@ import Utility.Misc
|
|||
import Utility.FileMode
|
||||
import Utility.Env
|
||||
|
||||
-- | When the specified PrivDataField is available on the host Propellor
|
||||
-- is provisioning, it provies the data to the action. Otherwise, it prints
|
||||
-- a message to help the user make the necessary private data available.
|
||||
withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Result
|
||||
withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
|
||||
-- | Allows a Property to access the value of a specific PrivDataField,
|
||||
-- for use in a specific Context.
|
||||
--
|
||||
-- Example use:
|
||||
--
|
||||
-- > withPrivData (PrivFile pemfile) (Context "joeyh.name") $ \getdata ->
|
||||
-- > property "joeyh.name ssl cert" $ getdata $ \privdata ->
|
||||
-- > liftIO $ writeFile pemfile privdata
|
||||
-- > where pemfile = "/etc/ssl/certs/web.pem"
|
||||
--
|
||||
-- Note that if the value is not available, the action is not run
|
||||
-- and instead it prints a message to help the user make the necessary
|
||||
-- private data available.
|
||||
withPrivData
|
||||
:: PrivDataField
|
||||
-> Context
|
||||
-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
|
||||
-> Property
|
||||
withPrivData field context@(Context cname) mkprop = addinfo $ mkprop $ \a ->
|
||||
maybe missing a =<< liftIO (getLocalPrivData field context)
|
||||
where
|
||||
missing = do
|
||||
host <- asks hostName
|
||||
let host' = if ".docker" `isSuffixOf` host
|
||||
then "$parent_host"
|
||||
else host
|
||||
liftIO $ do
|
||||
warningMessage $ "Missing privdata " ++ show field
|
||||
putStrLn $ "Fix this by running: propellor --set "++host'++" '" ++ show field ++ "'"
|
||||
return FailedChange
|
||||
missing = liftIO $ do
|
||||
warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")"
|
||||
putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'"
|
||||
return FailedChange
|
||||
addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, context) } }
|
||||
|
||||
getPrivData :: PrivDataField -> IO (Maybe String)
|
||||
getPrivData field = do
|
||||
m <- catchDefaultIO Nothing $ readish <$> readFile privDataLocal
|
||||
return $ maybe Nothing (M.lookup field) m
|
||||
{- Gets the requested field's value, in the specified context if it's
|
||||
- available, from the host's local privdata cache. -}
|
||||
getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData)
|
||||
getLocalPrivData field context =
|
||||
getPrivData field context . fromMaybe M.empty <$> localcache
|
||||
where
|
||||
localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal
|
||||
|
||||
setPrivData :: HostName -> PrivDataField -> IO ()
|
||||
setPrivData host field = do
|
||||
getPrivData :: PrivDataField -> Context -> (M.Map (PrivDataField, Context) PrivData) -> Maybe PrivData
|
||||
getPrivData field context = M.lookup (field, context)
|
||||
|
||||
setPrivData :: PrivDataField -> Context -> IO ()
|
||||
setPrivData field context = do
|
||||
putStrLn "Enter private data on stdin; ctrl-D when done:"
|
||||
setPrivDataTo host field =<< hGetContentsStrict stdin
|
||||
setPrivDataTo field context =<< hGetContentsStrict stdin
|
||||
|
||||
dumpPrivData :: HostName -> PrivDataField -> IO ()
|
||||
dumpPrivData host field =
|
||||
dumpPrivData :: PrivDataField -> Context -> IO ()
|
||||
dumpPrivData field context =
|
||||
maybe (error "Requested privdata is not set.") putStrLn
|
||||
=<< getPrivDataFor host field
|
||||
=<< (getPrivData field context <$> decryptPrivData)
|
||||
|
||||
editPrivData :: HostName -> PrivDataField -> IO ()
|
||||
editPrivData host field = do
|
||||
v <- getPrivDataFor host field
|
||||
editPrivData :: PrivDataField -> Context -> IO ()
|
||||
editPrivData field context = do
|
||||
v <- getPrivData field context <$> decryptPrivData
|
||||
v' <- withTmpFile "propellorXXXX" $ \f h -> do
|
||||
hClose h
|
||||
maybe noop (writeFileProtected f) v
|
||||
|
|
@ -66,35 +85,30 @@ editPrivData host field = do
|
|||
unlessM (boolSystem editor [File f]) $
|
||||
error "Editor failed; aborting."
|
||||
readFile f
|
||||
setPrivDataTo host field v'
|
||||
setPrivDataTo field context v'
|
||||
|
||||
listPrivDataFields :: HostName -> IO ()
|
||||
listPrivDataFields host = do
|
||||
putStrLn (host ++ "'s currently set privdata fields:")
|
||||
mapM_ list . M.keys =<< decryptPrivData host
|
||||
listPrivDataFields :: IO ()
|
||||
listPrivDataFields = do
|
||||
putStrLn ("All currently set privdata fields:")
|
||||
mapM_ list . M.keys =<< decryptPrivData
|
||||
where
|
||||
list = putStrLn . ("\t" ++) . shellEscape . show
|
||||
|
||||
setPrivDataTo :: HostName -> PrivDataField -> String -> IO ()
|
||||
setPrivDataTo host field value = do
|
||||
setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
|
||||
setPrivDataTo field context value = do
|
||||
makePrivDataDir
|
||||
let f = privDataFile host
|
||||
m <- decryptPrivData host
|
||||
let m' = M.insert field (chomp value) m
|
||||
gpgEncrypt f (show m')
|
||||
m <- decryptPrivData
|
||||
let m' = M.insert (field, context) (chomp value) m
|
||||
gpgEncrypt privDataFile (show m')
|
||||
putStrLn "Private data set."
|
||||
void $ boolSystem "git" [Param "add", File f]
|
||||
void $ boolSystem "git" [Param "add", File privDataFile]
|
||||
where
|
||||
chomp s
|
||||
| end s == "\n" = chomp (beginning s)
|
||||
| otherwise = s
|
||||
|
||||
getPrivDataFor :: HostName -> PrivDataField -> IO (Maybe String)
|
||||
getPrivDataFor host field = M.lookup field <$> decryptPrivData host
|
||||
|
||||
decryptPrivData :: HostName -> IO (M.Map PrivDataField String)
|
||||
decryptPrivData host = fromMaybe M.empty . readish
|
||||
<$> gpgDecrypt (privDataFile host)
|
||||
decryptPrivData :: IO (M.Map (PrivDataField, Context) PrivData)
|
||||
decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile
|
||||
|
||||
makePrivDataDir :: IO ()
|
||||
makePrivDataDir = createDirectoryIfMissing False privDataDir
|
||||
|
|
@ -102,8 +116,8 @@ makePrivDataDir = createDirectoryIfMissing False privDataDir
|
|||
privDataDir :: FilePath
|
||||
privDataDir = "privdata"
|
||||
|
||||
privDataFile :: HostName -> FilePath
|
||||
privDataFile host = privDataDir </> host ++ ".gpg"
|
||||
privDataFile :: FilePath
|
||||
privDataFile = privDataDir </> "privdata.gpg"
|
||||
|
||||
privDataLocal :: FilePath
|
||||
privDataLocal = privDataDir </> "local"
|
||||
|
|
|
|||
|
|
@ -55,10 +55,11 @@ installed = Apt.installed ["docker.io"]
|
|||
-- | Configures docker with an authentication file, so that images can be
|
||||
-- pushed to index.docker.io. Optional.
|
||||
configured :: Property
|
||||
configured = property "docker configured" go `requires` installed
|
||||
configured = prop `requires` installed
|
||||
where
|
||||
go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $
|
||||
"/root/.dockercfg" `File.hasContent` (lines cfg)
|
||||
prop = withPrivData DockerAuthentication anyContext $ \getcfg ->
|
||||
property "docker configured" $ getcfg $ \cfg -> ensureProperty $
|
||||
"/root/.dockercfg" `File.hasContent` (lines cfg)
|
||||
|
||||
-- | A short descriptive name for a container.
|
||||
-- Should not contain whitespace or other unusual characters,
|
||||
|
|
|
|||
|
|
@ -17,16 +17,17 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f)
|
|||
--
|
||||
-- The file's permissions are preserved if the file already existed.
|
||||
-- Otherwise, they're set to 600.
|
||||
hasPrivContent :: FilePath -> Property
|
||||
hasPrivContent f = property desc $ withPrivData (PrivFile f) $ \privcontent ->
|
||||
ensureProperty $ fileProperty' writeFileProtected desc
|
||||
(\_oldcontent -> lines privcontent) f
|
||||
hasPrivContent :: FilePath -> Context -> Property
|
||||
hasPrivContent f context = withPrivData (PrivFile f) context $ \getcontent ->
|
||||
property desc $ getcontent $ \privcontent ->
|
||||
ensureProperty $ fileProperty' writeFileProtected desc
|
||||
(\_oldcontent -> lines privcontent) f
|
||||
where
|
||||
desc = "privcontent " ++ f
|
||||
|
||||
-- | Leaves the file world-readable.
|
||||
hasPrivContentExposed :: FilePath -> Property
|
||||
hasPrivContentExposed f = hasPrivContent f `onChange`
|
||||
hasPrivContentExposed :: FilePath -> Context -> Property
|
||||
hasPrivContentExposed f context = hasPrivContent f context `onChange`
|
||||
mode f (combineModes (ownerWriteMode:readModes))
|
||||
|
||||
-- | Ensures that a line is present in a file, adding it to the end if not.
|
||||
|
|
|
|||
|
|
@ -9,6 +9,8 @@ import System.PosixCompat
|
|||
installed :: Property
|
||||
installed = Apt.installed ["gnupg"]
|
||||
|
||||
type GpgKeyId = String
|
||||
|
||||
-- | Sets up a user with a gpg key from the privdata.
|
||||
--
|
||||
-- Note that if a secret key is exported using gpg -a --export-secret-key,
|
||||
|
|
@ -21,19 +23,20 @@ installed = Apt.installed ["gnupg"]
|
|||
-- The GpgKeyId does not have to be a numeric id; it can just as easily
|
||||
-- be a description of the key.
|
||||
keyImported :: GpgKeyId -> UserName -> Property
|
||||
keyImported keyid user = flagFile' (property desc go) genflag
|
||||
keyImported keyid user = flagFile' prop genflag
|
||||
`requires` installed
|
||||
where
|
||||
desc = user ++ " has gpg key " ++ show keyid
|
||||
genflag = do
|
||||
d <- dotDir user
|
||||
return $ d </> ".propellor-imported-keyid-" ++ keyid
|
||||
go = withPrivData (GpgKey keyid) $ \key -> makeChange $
|
||||
withHandle StdinHandle createProcessSuccess
|
||||
(proc "su" ["-c", "gpg --import", user]) $ \h -> do
|
||||
fileEncoding h
|
||||
hPutStr h key
|
||||
hClose h
|
||||
prop = withPrivData GpgKey (Context keyid) $ \getkey ->
|
||||
property desc $ getkey $ \key -> makeChange $
|
||||
withHandle StdinHandle createProcessSuccess
|
||||
(proc "su" ["-c", "gpg --import", user]) $ \h -> do
|
||||
fileEncoding h
|
||||
hPutStr h key
|
||||
hClose h
|
||||
|
||||
dotDir :: UserName -> IO FilePath
|
||||
dotDir user = do
|
||||
|
|
|
|||
|
|
@ -25,5 +25,6 @@ providerFor users baseurl = propertyList desc $
|
|||
|
||||
-- the identitites directory controls access, so open up
|
||||
-- file mode
|
||||
identfile u = File.hasPrivContentExposed $
|
||||
concat $ [ "/var/lib/simpleid/identities/", u, ".identity" ]
|
||||
identfile u = File.hasPrivContentExposed
|
||||
(concat [ "/var/lib/simpleid/identities/", u, ".identity" ])
|
||||
(Context baseurl)
|
||||
|
|
|
|||
|
|
@ -23,29 +23,25 @@ builddir = gitbuilderdir </> "build"
|
|||
|
||||
type TimeOut = String -- eg, 5h
|
||||
|
||||
autobuilder :: CronTimes -> TimeOut -> Bool -> Property
|
||||
autobuilder crontimes timeout rsyncupload = combineProperties "gitannexbuilder"
|
||||
autobuilder :: Architecture -> CronTimes -> TimeOut -> Property
|
||||
autobuilder arch crontimes timeout = combineProperties "gitannexbuilder"
|
||||
[ Apt.serviceInstalledRunning "cron"
|
||||
, Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir $
|
||||
"git pull ; timeout " ++ timeout ++ " ./autobuild"
|
||||
-- The builduser account does not have a password set,
|
||||
-- instead use the password privdata to hold the rsync server
|
||||
-- password used to upload the built image.
|
||||
, property "rsync password" $ do
|
||||
let f = homedir </> "rsyncpassword"
|
||||
if rsyncupload
|
||||
then withPrivData (Password builduser) $ \p -> do
|
||||
oldp <- liftIO $ catchDefaultIO "" $
|
||||
readFileStrict f
|
||||
if p /= oldp
|
||||
then makeChange $ writeFile f p
|
||||
else noChange
|
||||
else do
|
||||
ifM (liftIO $ doesFileExist f)
|
||||
( noChange
|
||||
, makeChange $ writeFile f "no password configured"
|
||||
)
|
||||
, withPrivData (Password builduser) context $ \getpw ->
|
||||
property "rsync password" $ getpw $ \pw -> do
|
||||
oldpw <- liftIO $ catchDefaultIO "" $
|
||||
readFileStrict pwfile
|
||||
if pw /= oldpw
|
||||
then makeChange $ writeFile pwfile pw
|
||||
else noChange
|
||||
]
|
||||
where
|
||||
context = Context ("gitannexbuilder " ++ arch)
|
||||
pwfile = homedir </> "rsyncpassword"
|
||||
|
||||
tree :: Architecture -> Property
|
||||
tree buildarch = combineProperties "gitannexbuilder tree"
|
||||
|
|
@ -101,13 +97,13 @@ standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.conta
|
|||
& User.accountFor builduser
|
||||
& tree arch
|
||||
& buildDepsApt
|
||||
& autobuilder (show buildminute ++ " * * * *") timeout True
|
||||
& autobuilder arch (show buildminute ++ " * * * *") timeout
|
||||
|
||||
androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
|
||||
androidAutoBuilderContainer dockerImage crontimes timeout =
|
||||
androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir
|
||||
& Apt.unattendedUpgrades
|
||||
& autobuilder crontimes timeout True
|
||||
& autobuilder "android" crontimes timeout
|
||||
|
||||
-- Android is cross-built in a Debian i386 container, using the Android NDK.
|
||||
androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host
|
||||
|
|
@ -154,7 +150,7 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-
|
|||
-- The armel builder can ssh to this companion.
|
||||
& Docker.expose "22"
|
||||
& Apt.serviceInstalledRunning "ssh"
|
||||
& Ssh.authorizedKeys builduser
|
||||
& Ssh.authorizedKeys builduser (Context "armel-git-annex-builder")
|
||||
|
||||
armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
|
||||
armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder"
|
||||
|
|
@ -172,9 +168,9 @@ armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "arme
|
|||
-- git-annex/standalone/linux/install-haskell-packages
|
||||
-- which is not fully automated.)
|
||||
& buildDepsNoHaskellLibs
|
||||
& autobuilder crontimes timeout True
|
||||
& autobuilder "armel" crontimes timeout
|
||||
`requires` tree "armel"
|
||||
& Ssh.keyImported SshRsa builduser
|
||||
& Ssh.keyImported SshRsa builduser (Context "armel-git-annex-builder")
|
||||
& trivial writecompanionaddress
|
||||
where
|
||||
writecompanionaddress = scriptProperty
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ oldUseNetServer hosts = propertyList ("olduse.net server")
|
|||
[ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
|
||||
, "--client-name=spool"
|
||||
] Obnam.OnlyClient
|
||||
`requires` Ssh.keyImported SshRsa "root"
|
||||
`requires` Ssh.keyImported SshRsa "root" (Context "olduse.net")
|
||||
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
|
||||
, check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool) $
|
||||
property "olduse.net spool in place" $ makeChange $ do
|
||||
|
|
@ -97,7 +97,7 @@ kgbServer = withOS desc $ \o -> case o of
|
|||
(Just (System (Debian Unstable) _)) ->
|
||||
ensureProperty $ propertyList desc
|
||||
[ Apt.serviceInstalledRunning "kgb-bot"
|
||||
, File.hasPrivContent "/etc/kgb-bot/kgb.conf"
|
||||
, File.hasPrivContent "/etc/kgb-bot/kgb.conf" anyContext
|
||||
`onChange` Service.restarted "kgb-bot"
|
||||
, "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
|
||||
`describe` "kgb bot enabled"
|
||||
|
|
@ -108,17 +108,19 @@ kgbServer = withOS desc $ \o -> case o of
|
|||
desc = "kgb.kitenet.net setup"
|
||||
|
||||
mumbleServer :: [Host] -> Property
|
||||
mumbleServer hosts = combineProperties "mumble.debian.net"
|
||||
mumbleServer hosts = combineProperties hn
|
||||
[ Apt.serviceInstalledRunning "mumble-server"
|
||||
, Obnam.latestVersion
|
||||
, Obnam.backup "/var/lib/mumble-server" "55 5 * * *"
|
||||
[ "--repository=sftp://joey@turtle.kitenet.net/~/lib/backup/mumble.debian.net.obnam"
|
||||
[ "--repository=sftp://joey@turtle.kitenet.net/~/lib/backup/" ++ hn ++ ".obnam"
|
||||
, "--client-name=mumble"
|
||||
] Obnam.OnlyClient
|
||||
`requires` Ssh.keyImported SshRsa "root"
|
||||
`requires` Ssh.keyImported SshRsa "root" (Context hn)
|
||||
`requires` Ssh.knownHost hosts "turtle.kitenet.net" "root"
|
||||
, trivial $ cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]
|
||||
]
|
||||
where
|
||||
hn = "mumble.debian.net"
|
||||
|
||||
obnamLowMem :: Property
|
||||
obnamLowMem = combineProperties "obnam tuned for low memory use"
|
||||
|
|
@ -141,16 +143,16 @@ gitServer hosts = propertyList "git.kitenet.net setup"
|
|||
, "--client-name=wren"
|
||||
] Obnam.OnlyClient
|
||||
`requires` Gpg.keyImported "1B169BE1" "root"
|
||||
`requires` Ssh.keyImported SshRsa "root"
|
||||
`requires` Ssh.keyImported SshRsa "root" (Context "git.kitenet.net")
|
||||
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
|
||||
`requires` Ssh.authorizedKeys "family"
|
||||
`requires` Ssh.authorizedKeys "family" (Context "git.kitenet.net")
|
||||
`requires` User.accountFor "family"
|
||||
, Apt.installed ["git", "rsync", "gitweb"]
|
||||
-- backport avoids channel flooding on branch merge
|
||||
, Apt.installedBackport ["kgb-client"]
|
||||
-- backport supports ssh event notification
|
||||
, Apt.installedBackport ["git-annex"]
|
||||
, File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf"
|
||||
, File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf" anyContext
|
||||
, toProp $ Git.daemonRunning "/srv/git"
|
||||
, "/etc/gitweb.conf" `File.containsLines`
|
||||
[ "$projectroot = '/srv/git';"
|
||||
|
|
@ -202,7 +204,7 @@ annexWebSite hosts origin hn uuid remotes = propertyList (hn ++" website using g
|
|||
dir = "/srv/web/" ++ hn
|
||||
postupdatehook = dir </> ".git/hooks/post-update"
|
||||
setup = userScriptProperty "joey" setupscript
|
||||
`requires` Ssh.keyImported SshRsa "joey"
|
||||
`requires` Ssh.keyImported SshRsa "joey" (Context hn)
|
||||
`requires` Ssh.knownHost hosts "turtle.kitenet.net" "joey"
|
||||
setupscript =
|
||||
[ "cd " ++ shellEscape dir
|
||||
|
|
@ -270,9 +272,9 @@ mainhttpscert True =
|
|||
gitAnnexDistributor :: Property
|
||||
gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer"
|
||||
[ Apt.installed ["rsync"]
|
||||
, File.hasPrivContent "/etc/rsyncd.conf"
|
||||
, File.hasPrivContent "/etc/rsyncd.conf" (Context "git-annex distributor")
|
||||
`onChange` Service.restarted "rsync"
|
||||
, File.hasPrivContent "/etc/rsyncd.secrets"
|
||||
, File.hasPrivContent "/etc/rsyncd.secrets" (Context "git-annex distributor")
|
||||
`onChange` Service.restarted "rsync"
|
||||
, "/etc/default/rsync" `File.containsLine` "RSYNC_ENABLE=true"
|
||||
`onChange` Service.running "rsync"
|
||||
|
|
@ -315,7 +317,7 @@ ircBouncer = propertyList "IRC bouncer"
|
|||
[ Apt.installed ["znc"]
|
||||
, User.accountFor "znc"
|
||||
, File.dirExists (parentDir conf)
|
||||
, File.hasPrivContent conf
|
||||
, File.hasPrivContent conf anyContext
|
||||
, File.ownerGroup conf "znc" "znc"
|
||||
, Cron.job "znconboot" "@reboot" "znc" "~" "znc"
|
||||
-- ensure running if it was not already
|
||||
|
|
@ -341,7 +343,7 @@ githubBackup :: Property
|
|||
githubBackup = propertyList "github-backup box"
|
||||
[ Apt.installed ["github-backup", "moreutils"]
|
||||
, let f = "/home/joey/.github-keys"
|
||||
in File.hasPrivContent f
|
||||
in File.hasPrivContent f anyContext
|
||||
`onChange` File.ownerGroup f "joey" "joey"
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -75,42 +75,43 @@ randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
|
|||
ensureProperty $ scriptProperty
|
||||
[ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ]
|
||||
|
||||
-- | Sets ssh host keys from the site's PrivData.
|
||||
--
|
||||
-- (Uses a null username for host keys.)
|
||||
hostKey :: SshKeyType -> Property
|
||||
hostKey keytype = combineProperties desc
|
||||
[ property desc (install writeFile (SshPubKey keytype "") ".pub")
|
||||
, property desc (install writeFileProtected (SshPrivKey keytype "") "")
|
||||
-- | Sets ssh host keys.
|
||||
hostKey :: SshKeyType -> Context -> Property
|
||||
hostKey keytype context = combineProperties desc
|
||||
[ installkey (SshPubKey keytype "") (install writeFile ".pub")
|
||||
, installkey (SshPrivKey keytype "") (install writeFileProtected "")
|
||||
]
|
||||
`onChange` restartSshd
|
||||
where
|
||||
desc = "known ssh host key (" ++ fromKeyType keytype ++ ")"
|
||||
install writer p ext = withPrivData p $ \key -> do
|
||||
installkey p a = withPrivData p context $ \getkey ->
|
||||
property desc $ getkey a
|
||||
install writer ext key = do
|
||||
let f = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
|
||||
s <- liftIO $ readFileStrict f
|
||||
if s == key
|
||||
then noChange
|
||||
else makeChange $ writer f key
|
||||
|
||||
-- | Sets up a user with a ssh private key and public key pair
|
||||
-- from the site's PrivData.
|
||||
keyImported :: SshKeyType -> UserName -> Property
|
||||
keyImported keytype user = combineProperties desc
|
||||
[ property desc (install writeFile (SshPubKey keytype user) ".pub")
|
||||
, property desc (install writeFileProtected (SshPrivKey keytype user) "")
|
||||
-- | Sets up a user with a ssh private key and public key pair from the
|
||||
-- PrivData.
|
||||
keyImported :: SshKeyType -> UserName -> Context -> Property
|
||||
keyImported keytype user context = combineProperties desc
|
||||
[ installkey (SshPubKey keytype user) (install writeFile ".pub")
|
||||
, installkey (SshPrivKey keytype user) (install writeFileProtected "")
|
||||
]
|
||||
where
|
||||
desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")"
|
||||
install writer p ext = do
|
||||
installkey p a = withPrivData p context $ \getkey ->
|
||||
property desc $ getkey a
|
||||
install writer ext key = do
|
||||
f <- liftIO $ keyfile ext
|
||||
ifM (liftIO $ doesFileExist f)
|
||||
( noChange
|
||||
, ensureProperties
|
||||
[ property desc $
|
||||
withPrivData p $ \key -> makeChange $ do
|
||||
createDirectoryIfMissing True (takeDirectory f)
|
||||
writer f key
|
||||
[ property desc $ makeChange $ do
|
||||
createDirectoryIfMissing True (takeDirectory f)
|
||||
writer f key
|
||||
, File.ownerGroup f user user
|
||||
, File.ownerGroup (takeDirectory f) user user
|
||||
]
|
||||
|
|
@ -143,9 +144,9 @@ knownHost hosts hn user = property desc $
|
|||
return FailedChange
|
||||
|
||||
-- | Makes a user have authorized_keys from the PrivData
|
||||
authorizedKeys :: UserName -> Property
|
||||
authorizedKeys user = property (user ++ " has authorized_keys") $
|
||||
withPrivData (SshAuthorizedKeys user) $ \v -> do
|
||||
authorizedKeys :: UserName -> Context -> Property
|
||||
authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get ->
|
||||
property (user ++ " has authorized_keys") $ get $ \v -> do
|
||||
f <- liftIO $ dotFile "authorized_keys" user
|
||||
liftIO $ do
|
||||
createDirectoryIfMissing True (takeDirectory f)
|
||||
|
|
|
|||
|
|
@ -24,17 +24,18 @@ nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "use
|
|||
|
||||
-- | Only ensures that the user has some password set. It may or may
|
||||
-- not be the password from the PrivData.
|
||||
hasSomePassword :: UserName -> Property
|
||||
hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $
|
||||
hasPassword user
|
||||
hasSomePassword :: UserName -> Context -> Property
|
||||
hasSomePassword user context = check ((/= HasPassword) <$> getPasswordStatus user) $
|
||||
hasPassword user context
|
||||
|
||||
hasPassword :: UserName -> Property
|
||||
hasPassword user = property (user ++ " has password") $
|
||||
withPrivData (Password user) $ \password -> makeChange $
|
||||
withHandle StdinHandle createProcessSuccess
|
||||
(proc "chpasswd" []) $ \h -> do
|
||||
hPutStrLn h $ user ++ ":" ++ password
|
||||
hClose h
|
||||
hasPassword :: UserName -> Context -> Property
|
||||
hasPassword user context = withPrivData (Password user) context $ \getpassword ->
|
||||
property (user ++ " has password") $
|
||||
getpassword $ \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"
|
||||
|
|
|
|||
|
|
@ -17,7 +17,9 @@ module Propellor.Types
|
|||
, ActionResult(..)
|
||||
, CmdLine(..)
|
||||
, PrivDataField(..)
|
||||
, GpgKeyId
|
||||
, PrivData
|
||||
, Context(..)
|
||||
, anyContext
|
||||
, SshKeyType(..)
|
||||
, module Propellor.Types.OS
|
||||
, module Propellor.Types.Dns
|
||||
|
|
@ -32,6 +34,7 @@ import "MonadCatchIO-transformers" Control.Monad.CatchIO
|
|||
import Propellor.Types.Info
|
||||
import Propellor.Types.OS
|
||||
import Propellor.Types.Dns
|
||||
import Propellor.Types.PrivData
|
||||
|
||||
-- | Everything Propellor knows about a system: Its hostname,
|
||||
-- properties and other info.
|
||||
|
|
@ -135,30 +138,12 @@ data CmdLine
|
|||
= Run HostName
|
||||
| Spin HostName
|
||||
| Boot HostName
|
||||
| Set HostName PrivDataField
|
||||
| Dump HostName PrivDataField
|
||||
| Edit HostName PrivDataField
|
||||
| ListFields HostName
|
||||
| Set PrivDataField Context
|
||||
| Dump PrivDataField Context
|
||||
| Edit PrivDataField Context
|
||||
| ListFields
|
||||
| AddKey String
|
||||
| Continue CmdLine
|
||||
| Chain HostName
|
||||
| Docker HostName
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
-- | Note that removing or changing field names will break the
|
||||
-- serialized privdata files, so don't do that!
|
||||
-- It's fine to add new fields.
|
||||
data PrivDataField
|
||||
= DockerAuthentication
|
||||
| SshPubKey SshKeyType UserName
|
||||
| SshPrivKey SshKeyType UserName
|
||||
| SshAuthorizedKeys UserName
|
||||
| Password UserName
|
||||
| PrivFile FilePath
|
||||
| GpgKey GpgKeyId
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
||||
type GpgKeyId = String
|
||||
|
||||
data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
module Propellor.Types.Info where
|
||||
|
||||
import Propellor.Types.OS
|
||||
import Propellor.Types.PrivData
|
||||
import qualified Propellor.Types.Dns as Dns
|
||||
|
||||
import qualified Data.Set as S
|
||||
|
|
@ -9,6 +10,7 @@ import Data.Monoid
|
|||
-- | Information about a host.
|
||||
data Info = Info
|
||||
{ _os :: Val System
|
||||
, _privDataFields :: S.Set (PrivDataField, Context)
|
||||
, _sshPubKey :: Val String
|
||||
, _dns :: S.Set Dns.Record
|
||||
, _namedconf :: Dns.NamedConfMap
|
||||
|
|
@ -17,9 +19,10 @@ data Info = Info
|
|||
deriving (Eq, Show)
|
||||
|
||||
instance Monoid Info where
|
||||
mempty = Info mempty mempty mempty mempty mempty
|
||||
mempty = Info mempty mempty mempty mempty mempty mempty
|
||||
mappend old new = Info
|
||||
{ _os = _os old <> _os new
|
||||
, _privDataFields = _privDataFields old <> _privDataFields new
|
||||
, _sshPubKey = _sshPubKey old <> _sshPubKey new
|
||||
, _dns = _dns old <> _dns new
|
||||
, _namedconf = _namedconf old <> _namedconf new
|
||||
|
|
|
|||
|
|
@ -0,0 +1,34 @@
|
|||
module Propellor.Types.PrivData where
|
||||
|
||||
import Propellor.Types.OS
|
||||
|
||||
-- | Note that removing or changing field names will break the
|
||||
-- serialized privdata files, so don't do that!
|
||||
-- It's fine to add new fields.
|
||||
data PrivDataField
|
||||
= DockerAuthentication
|
||||
| SshPubKey SshKeyType UserName
|
||||
| SshPrivKey SshKeyType UserName
|
||||
| SshAuthorizedKeys UserName
|
||||
| Password UserName
|
||||
| PrivFile FilePath
|
||||
| GpgKey
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
||||
-- | Context in which a PrivDataField is used.
|
||||
--
|
||||
-- Often this will be a domain name. For example,
|
||||
-- Context "www.example.com" could be used for the SSL cert
|
||||
-- for the web server serving that domain. Multiple hosts might
|
||||
-- use that privdata.
|
||||
newtype Context = Context String
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
||||
-- | Use when a PrivDataField is not dependent on any paricular context.
|
||||
anyContext :: Context
|
||||
anyContext = Context "any"
|
||||
|
||||
type PrivData = String
|
||||
|
||||
data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
Loading…
Reference in New Issue