From 23399416f1ba89894f65f61b436c2b0f8378e6c5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 14 Dec 2014 16:14:05 -0400 Subject: broke up big function to describe PrivDataField --- src/Propellor/PrivData.hs | 23 +++++++++++----------- src/Propellor/Property/Docker.hs | 4 +++- src/Propellor/Property/File.hs | 2 +- src/Propellor/Property/Gpg.hs | 3 ++- src/Propellor/Property/Ssh.hs | 6 ++++-- src/Propellor/Property/User.hs | 7 ++++++- src/Propellor/Types/PrivData.hs | 42 ++++++++++++++++++++++++---------------- 7 files changed, 53 insertions(+), 34 deletions(-) (limited to 'src') 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. -- -- cgit v1.2.3