summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2014-12-14 16:14:05 -0400
committerJoey Hess2014-12-14 16:14:05 -0400
commit23399416f1ba89894f65f61b436c2b0f8378e6c5 (patch)
tree161b0d4bcf18cd7fb9bf58a7a7089b868dad2777 /src
parent71723ca09f369ccf96462cef1e0200e1615677d1 (diff)
broke up big function to describe PrivDataField
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/PrivData.hs23
-rw-r--r--src/Propellor/Property/Docker.hs4
-rw-r--r--src/Propellor/Property/File.hs2
-rw-r--r--src/Propellor/Property/Gpg.hs3
-rw-r--r--src/Propellor/Property/Ssh.hs6
-rw-r--r--src/Propellor/Property/User.hs7
-rw-r--r--src/Propellor/Types/PrivData.hs42
7 files changed, 53 insertions, 34 deletions
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index b0228b46..6253e924 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -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
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 2c8af413..b48afbbb 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -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,
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index a1a86763..76de68c0 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -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
diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs
index 5819ea7b..4a3e1872 100644
--- a/src/Propellor/Property/Gpg.hs
+++ b/src/Propellor/Property/Gpg.hs
@@ -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
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index fcae6498..695b67cb 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -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.
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index 549aa07f..f79ede63 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -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
diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs
index ab3e108a..f746a74c 100644
--- a/src/Propellor/Types/PrivData.hs
+++ b/src/Propellor/Types/PrivData.hs
@@ -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.
--