broke up big function to describe PrivDataField
This commit is contained in:
parent
71723ca09f
commit
23399416f1
File diff suppressed because it is too large
Load Diff
|
@ -48,30 +48,30 @@ import Utility.Table
|
|||
-- being used, which is necessary to ensure that the privdata is sent to
|
||||
-- the remote host by propellor.
|
||||
withPrivData
|
||||
:: IsContext c
|
||||
=> PrivDataField
|
||||
:: (IsContext c, IsPrivDataSource s)
|
||||
=> s
|
||||
-> c
|
||||
-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
|
||||
-> Property
|
||||
withPrivData field = withPrivData' snd [field]
|
||||
withPrivData s = withPrivData' snd [s]
|
||||
|
||||
-- Like withPrivData, but here any of a list of PrivDataFields can be used.
|
||||
withSomePrivData
|
||||
:: IsContext c
|
||||
=> [PrivDataField]
|
||||
:: (IsContext c, IsPrivDataSource s)
|
||||
=> [s]
|
||||
-> c
|
||||
-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property)
|
||||
-> Property
|
||||
withSomePrivData = withPrivData' id
|
||||
|
||||
withPrivData'
|
||||
:: IsContext c
|
||||
:: (IsContext c, IsPrivDataSource s)
|
||||
=> ((PrivDataField, PrivData) -> v)
|
||||
-> [PrivDataField]
|
||||
-> [s]
|
||||
-> c
|
||||
-> (((v -> Propellor Result) -> Propellor Result) -> Property)
|
||||
-> Property
|
||||
withPrivData' feed fieldlist c mkprop = addinfo $ mkprop $ \a ->
|
||||
withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
|
||||
maybe missing (a . feed) =<< getM get fieldlist
|
||||
where
|
||||
get field = do
|
||||
|
@ -82,14 +82,15 @@ withPrivData' feed fieldlist c mkprop = addinfo $ mkprop $ \a ->
|
|||
Context cname <- mkHostContext hc <$> asks hostName
|
||||
warningMessage $ "Missing privdata " ++ intercalate " or " fieldnames ++ " (for " ++ cname ++ ")"
|
||||
liftIO $ putStrLn $ "Fix this by running:"
|
||||
liftIO $ forM_ fieldlist $ \f -> do
|
||||
putStrLn $ " propellor --set '" ++ show f ++ "' '" ++ cname ++ "'"
|
||||
putStrLn $ " < ( " ++ howtoMkPrivDataField f ++ " )"
|
||||
liftIO $ forM_ srclist $ \src -> do
|
||||
putStrLn $ " propellor --set '" ++ show (privDataField src) ++ "' '" ++ cname ++ "'"
|
||||
maybe noop (\d -> putStrLn $ " " ++ d) (describePrivDataSource src)
|
||||
putStrLn ""
|
||||
return FailedChange
|
||||
addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = fieldset } }
|
||||
fieldnames = map show fieldlist
|
||||
fieldset = S.fromList $ zip fieldlist (repeat hc)
|
||||
fieldlist = map privDataField srclist
|
||||
hc = asHostContext c
|
||||
|
||||
addPrivDataField :: (PrivDataField, HostContext) -> Property
|
||||
|
|
|
@ -63,9 +63,11 @@ installed = Apt.installed ["docker.io"]
|
|||
configured :: Property
|
||||
configured = prop `requires` installed
|
||||
where
|
||||
prop = withPrivData DockerAuthentication anyContext $ \getcfg ->
|
||||
prop = withPrivData src anyContext $ \getcfg ->
|
||||
property "docker configured" $ getcfg $ \cfg -> ensureProperty $
|
||||
"/root/.dockercfg" `File.hasContent` (lines cfg)
|
||||
src = PrivDataSourceFileFromCommand DockerAuthentication
|
||||
"/root/.dockercfg" "docker login"
|
||||
|
||||
-- | A short descriptive name for a container.
|
||||
-- Should not contain whitespace or other unusual characters,
|
||||
|
|
|
@ -29,7 +29,7 @@ hasPrivContentExposed = hasPrivContent' writeFile
|
|||
|
||||
hasPrivContent' :: IsContext c => (String -> FilePath -> IO ()) -> FilePath -> c -> Property
|
||||
hasPrivContent' writer f context =
|
||||
withPrivData (PrivFile f) context $ \getcontent ->
|
||||
withPrivData (PrivDataSourceFile (PrivFile f) f) context $ \getcontent ->
|
||||
property desc $ getcontent $ \privcontent ->
|
||||
ensureProperty $ fileProperty' writer desc
|
||||
(\_oldcontent -> lines privcontent) f
|
||||
|
|
|
@ -28,13 +28,14 @@ keyImported (GpgKeyId keyid) user = flagFile' prop genflag
|
|||
genflag = do
|
||||
d <- dotDir user
|
||||
return $ d </> ".propellor-imported-keyid-" ++ keyid
|
||||
prop = withPrivData GpgKey (Context keyid) $ \getkey ->
|
||||
prop = withPrivData src (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
|
||||
src = PrivDataSource GpgKey "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a"
|
||||
|
||||
dotDir :: UserName -> IO FilePath
|
||||
dotDir user = do
|
||||
|
|
|
@ -90,8 +90,8 @@ hostKeys ctx = propertyList "known ssh host keys"
|
|||
-- | Sets a single ssh host key from the privdata.
|
||||
hostKey :: IsContext c => SshKeyType -> c -> Property
|
||||
hostKey keytype context = combineProperties desc
|
||||
[ installkey (SshPubKey keytype "") (install writeFile ".pub")
|
||||
, installkey (SshPrivKey keytype "") (install writeFileProtected "")
|
||||
[ installkey (keysrc ".pub" (SshPubKey keytype "")) (install writeFile ".pub")
|
||||
, installkey (keysrc "" (SshPrivKey keytype "")) (install writeFileProtected "")
|
||||
]
|
||||
`onChange` restarted
|
||||
where
|
||||
|
@ -104,6 +104,8 @@ hostKey keytype context = combineProperties desc
|
|||
if s == key
|
||||
then noChange
|
||||
else makeChange $ writer f key
|
||||
keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext)
|
||||
("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey")
|
||||
|
||||
-- | Sets up a user with a ssh private key and public key pair from the
|
||||
-- PrivData.
|
||||
|
|
|
@ -46,8 +46,13 @@ hasPassword user = hasPassword' user hostContext
|
|||
hasPassword' :: IsContext c => UserName -> c -> Property
|
||||
hasPassword' user context = go `requires` shadowConfig True
|
||||
where
|
||||
go = withSomePrivData [CryptPassword user, Password user] context $
|
||||
go = withSomePrivData srcs context $
|
||||
property (user ++ " has password") . setPassword
|
||||
srcs =
|
||||
[ PrivDataSource (CryptPassword user)
|
||||
"a crypt(3)ed password, which can be generated by, for example: perl -e 'print crypt(shift, q{$6$}.shift)' 'somepassword' 'somesalt'"
|
||||
, PrivDataSource (Password user) ("a password for " ++ user)
|
||||
]
|
||||
|
||||
setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
|
||||
setPassword getpassword = getpassword $ go
|
||||
|
|
|
@ -16,23 +16,31 @@ data PrivDataField
|
|||
| GpgKey
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
||||
-- | Explains how the user can generate a particular PrivDataField.
|
||||
howtoMkPrivDataField :: PrivDataField -> String
|
||||
howtoMkPrivDataField fld = case fld of
|
||||
DockerAuthentication -> "/root/.dockercfg" `genbycmd` "docker login"
|
||||
SshPubKey keytype _ -> forexample $
|
||||
"sshkey.pub" `genbycmd` keygen keytype
|
||||
SshPrivKey keytype _ -> forexample $
|
||||
"sshkey" `genbycmd` keygen keytype
|
||||
SshAuthorizedKeys _ -> forexample "~/.ssh/id_rsa.pub"
|
||||
Password username -> "a password for " ++ username
|
||||
CryptPassword _ -> "a crypt(3)ed password, which can be generated by, for example: perl -e 'print crypt(shift, q{$6$}.shift)' 'somepassword' 'somesalt'"
|
||||
PrivFile f -> "file contents for " ++ f
|
||||
GpgKey -> "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a"
|
||||
where
|
||||
genbycmd f cmd = f ++ " generated by running `" ++ cmd ++ "`"
|
||||
keygen keytype = "ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey"
|
||||
forexample s = "for example, " ++ s
|
||||
-- | Combines a PrivDataField with a description of how to generate
|
||||
-- its value.
|
||||
data PrivDataSource
|
||||
= PrivDataSourceFile PrivDataField FilePath
|
||||
| PrivDataSourceFileFromCommand PrivDataField FilePath String
|
||||
| PrivDataSource PrivDataField String
|
||||
|
||||
class IsPrivDataSource s where
|
||||
privDataField :: s -> PrivDataField
|
||||
describePrivDataSource :: s -> Maybe String
|
||||
|
||||
instance IsPrivDataSource PrivDataField where
|
||||
privDataField = id
|
||||
describePrivDataSource _ = Nothing
|
||||
|
||||
instance IsPrivDataSource PrivDataSource where
|
||||
privDataField s = case s of
|
||||
PrivDataSourceFile f _ -> f
|
||||
PrivDataSourceFileFromCommand f _ _ -> f
|
||||
PrivDataSource f _ -> f
|
||||
describePrivDataSource s = Just $ case s of
|
||||
PrivDataSourceFile _ f -> "< " ++ f
|
||||
PrivDataSourceFileFromCommand _ f c ->
|
||||
"< " ++ f ++ " (created by running, for example, `" ++ c ++ "` )"
|
||||
PrivDataSource _ d -> "< (" ++ d ++ ")"
|
||||
|
||||
-- | A context in which a PrivDataField is used.
|
||||
--
|
||||
|
|
Loading…
Reference in New Issue