summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2015-09-14 20:11:25 -0400
committerJoey Hess2015-09-14 20:11:25 -0400
commit9a0169f0cbdf2470e149a32f5fab8ec2369686f3 (patch)
treec8d4dc9f3a970b7ce3622370a8ff8ee8869b413c /src
parent115baccc7761356ec6633202e69dfff65f53a993 (diff)
clean up privdata excess/lacking newline issue
* PrivData converted to newtype (API change). * Stopped stripping trailing newlines when setting PrivData; this was previously done to avoid mistakes when pasting eg passwords with an unwanted newline. Instead, PrivData consumers should use either privDataLines or privDataVal, to extract respectively lines or a value (without internal newlines) from PrivData.
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/PrivData.hs22
-rw-r--r--src/Propellor/Property/Docker.hs2
-rw-r--r--src/Propellor/Property/File.hs2
-rw-r--r--src/Propellor/Property/Gpg.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs7
-rw-r--r--src/Propellor/Property/SiteSpecific/IABak.hs2
-rw-r--r--src/Propellor/Property/Ssh.hs25
-rw-r--r--src/Propellor/Property/Tor.hs4
-rw-r--r--src/Propellor/Property/User.hs4
-rw-r--r--src/Propellor/Types/PrivData.hs21
10 files changed, 60 insertions, 31 deletions
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index cbb296ce..b7932518 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -132,7 +132,7 @@ getLocalPrivData field context =
where
localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal
-type PrivMap = M.Map (PrivDataField, Context) PrivData
+type PrivMap = M.Map (PrivDataField, Context) String
-- | Get only the set of PrivData that the Host's Info says it uses.
filterPrivData :: Host -> PrivMap -> PrivMap
@@ -142,12 +142,14 @@ filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
fromPrivInfo $ getInfo $ hostInfo host
getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
-getPrivData field context = M.lookup (field, context)
+getPrivData field context m = do
+ s <- M.lookup (field, context) m
+ return (PrivData s)
setPrivData :: PrivDataField -> Context -> IO ()
setPrivData field context = do
putStrLn "Enter private data on stdin; ctrl-D when done:"
- setPrivDataTo field context =<< hGetContentsStrict stdin
+ setPrivDataTo field context . PrivData =<< hGetContentsStrict stdin
unsetPrivData :: PrivDataField -> Context -> IO ()
unsetPrivData field context = do
@@ -156,7 +158,8 @@ unsetPrivData field context = do
dumpPrivData :: PrivDataField -> Context -> IO ()
dumpPrivData field context =
- maybe (error "Requested privdata is not set.") putStrLn
+ maybe (error "Requested privdata is not set.")
+ (mapM_ putStrLn . privDataLines)
=<< (getPrivData field context <$> decryptPrivData)
editPrivData :: PrivDataField -> Context -> IO ()
@@ -164,11 +167,11 @@ editPrivData field context = do
v <- getPrivData field context <$> decryptPrivData
v' <- withTmpFile "propellorXXXX" $ \f h -> do
hClose h
- maybe noop (writeFileProtected f) v
+ maybe noop (writeFileProtected f . unlines . privDataLines) v
editor <- getEnvDefault "EDITOR" "vi"
unlessM (boolSystem editor [File f]) $
error "Editor failed; aborting."
- readFile f
+ PrivData <$> readFile f
setPrivDataTo field context v'
listPrivDataFields :: [Host] -> IO ()
@@ -202,14 +205,11 @@ listPrivDataFields hosts = do
putStr $ unlines $ formatTable $ tableWithHeader header rows
setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
-setPrivDataTo field context value = do
+setPrivDataTo field context (PrivData value) = do
modifyPrivData set
putStrLn "Private data set."
where
- set = M.insert (field, context) (chomp value)
- chomp s
- | end s == "\n" = chomp (beginning s)
- | otherwise = s
+ set = M.insert (field, context) value
modifyPrivData :: (PrivMap -> PrivMap) -> IO ()
modifyPrivData f = do
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 8c70b714..9cfc24b6 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -75,7 +75,7 @@ configured = prop `requires` installed
where
prop = withPrivData src anyContext $ \getcfg ->
property "docker configured" $ getcfg $ \cfg -> ensureProperty $
- "/root/.dockercfg" `File.hasContent` (lines cfg)
+ "/root/.dockercfg" `File.hasContent` privDataLines cfg
src = PrivDataSourceFileFromCommand DockerAuthentication
"/root/.dockercfg" "docker login"
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 4e074eee..4563fe79 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -40,7 +40,7 @@ hasPrivContent' writer source f context =
withPrivData source context $ \getcontent ->
property desc $ getcontent $ \privcontent ->
ensureProperty $ fileProperty' writer desc
- (\_oldcontent -> lines privcontent) f
+ (\_oldcontent -> privDataLines privcontent) f
where
desc = "privcontent " ++ f
diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs
index 0f68f8fe..e57749ae 100644
--- a/src/Propellor/Property/Gpg.hs
+++ b/src/Propellor/Property/Gpg.hs
@@ -33,7 +33,7 @@ keyImported (GpgKeyId keyid) user@(User u) = flagFile' prop genflag
withHandle StdinHandle createProcessSuccess
(proc "su" ["-c", "gpg --import", u]) $ \h -> do
fileEncoding h
- hPutStr h key
+ hPutStr h (unlines (privDataLines 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"
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 6a6d5bfd..bd8b1ff3 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -39,10 +39,11 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
-- password used to upload the built image.
rsyncpassword = withPrivData (Password builduser) context $ \getpw ->
property "rsync password" $ getpw $ \pw -> do
- oldpw <- liftIO $ catchDefaultIO "" $
+ have <- liftIO $ catchDefaultIO "" $
readFileStrict pwfile
- if pw /= oldpw
- then makeChange $ writeFile pwfile pw
+ let want = privDataVal pw
+ if want /= have
+ then makeChange $ writeFile pwfile want
else noChange
tree :: Architecture -> Property HasInfo
diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs
index 8c9926bc..68313f20 100644
--- a/src/Propellor/Property/SiteSpecific/IABak.hs
+++ b/src/Propellor/Property/SiteSpecific/IABak.hs
@@ -103,4 +103,4 @@ graphiteServer = propertyList "iabak graphite server" $ props
graphiteCSRF = withPrivData (Password "csrf-token") (Context "iabak.archiveteam.org") $
\gettoken -> property "graphite-web CSRF token" $
gettoken $ \token -> ensureProperty $ File.containsLine
- "/etc/graphite/local_settings.py" ("SECRET_KEY = '"++ token ++"'")
+ "/etc/graphite/local_settings.py" ("SECRET_KEY = '"++ privDataVal token ++"'")
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 5f0082cb..fbd57057 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -147,22 +147,29 @@ hostKeys ctx l = propertyList desc $ catMaybes $
hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property HasInfo
hostKey context keytype pub = combineProperties desc
[ pubKey keytype pub
- , toProp $ property desc $ install writeFile True pub
+ , toProp $ property desc $ install writeFile True (lines pub)
, withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey ->
- property desc $ getkey $ install writeFileProtected False
+ property desc $ getkey $
+ install writeFileProtected False . privDataLines
]
`onChange` restarted
where
desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")"
- install writer ispub key = do
+ install writer ispub keylines = do
let f = keyFile keytype ispub
- s <- liftIO $ catchDefaultIO "" $ readFileStrict f
- if s == key
+ have <- liftIO $ catchDefaultIO "" $ readFileStrict f
+ let want = keyFileContent keylines
+ if have == want
then noChange
- else makeChange $ writer f key
+ else makeChange $ writer f want
keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext)
("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey")
+-- Make sure that there is a newline at the end;
+-- ssh requires this for some types of private keys.
+keyFileContent :: [String] -> String
+keyFileContent keylines = unlines (keylines ++ [""])
+
keyFile :: SshKeyType -> Bool -> FilePath
keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
where
@@ -221,7 +228,7 @@ keyImported' dest keytype user@(User u) context = combineProperties desc
, ensureProperties
[ property desc $ makeChange $ do
createDirectoryIfMissing True (takeDirectory f)
- writer f key
+ writer f (keyFileContent (privDataLines key))
, File.ownerGroup f user (userGroup user)
, File.ownerGroup (takeDirectory f) user (userGroup user)
]
@@ -232,6 +239,8 @@ keyImported' dest keytype user@(User u) context = combineProperties desc
return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
Just f -> return $ f ++ ext
+
+
fromKeyType :: SshKeyType -> String
fromKeyType SshRsa = "rsa"
fromKeyType SshDsa = "dsa"
@@ -267,7 +276,7 @@ authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) contex
f <- liftIO $ dotFile "authorized_keys" user
liftIO $ do
createDirectoryIfMissing True (takeDirectory f)
- writeFileProtected f v
+ writeFileProtected f (keyFileContent (privDataLines v))
ensureProperties
[ File.ownerGroup f user (userGroup user)
, File.ownerGroup (takeDirectory f) user (userGroup user)
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index 535da951..e2ee3dad 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -134,12 +134,12 @@ hiddenServiceData hn context = combineProperties desc
desc = unwords ["hidden service data available in", varLib </> hn]
installonion f = withPrivData (PrivFile $ varLib </> hn </> f) context $ \getcontent ->
property desc $ getcontent $ install $ varLib </> hn </> f
- install f content = ifM (liftIO $ doesFileExist f)
+ install f privcontent = ifM (liftIO $ doesFileExist f)
( noChange
, ensureProperties
[ property desc $ makeChange $ do
createDirectoryIfMissing True (takeDirectory f)
- writeFileProtected f content
+ writeFileProtected f (unlines (privDataLines privcontent))
, File.mode (takeDirectory f) $ combineModes
[ownerReadMode, ownerWriteMode, ownerExecuteMode]
, File.ownerGroup (takeDirectory f) user (userGroup user)
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index add3ae52..c029999f 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -58,8 +58,8 @@ hasPassword' (User u) context = go `requires` shadowConfig True
setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
setPassword getpassword = getpassword $ go
where
- go (Password user, password) = set user password []
- go (CryptPassword user, hash) = set user hash ["--encrypted"]
+ go (Password user, password) = set user (privDataVal password) []
+ go (CryptPassword user, hash) = set user (privDataVal hash) ["--encrypted"]
go (f, _) = error $ "Unexpected type of privdata: " ++ show f
set user v ps = makeChange $ withHandle StdinHandle createProcessSuccess
diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs
index d713c7cf..c72838cb 100644
--- a/src/Propellor/Types/PrivData.hs
+++ b/src/Propellor/Types/PrivData.hs
@@ -1,6 +1,9 @@
module Propellor.Types.PrivData where
import Propellor.Types.OS
+import Utility.PartialPrelude
+
+import Data.Maybe
-- | Note that removing or changing constructors or changing types will
-- break the serialized privdata files, so don't do that!
@@ -89,7 +92,23 @@ anyContext = Context "any"
hostContext :: HostContext
hostContext = HostContext Context
-type PrivData = String
+-- | Contains the actual private data.
+--
+-- Note that this may contain exta newlines at the end, or they may have
+-- been stripped off, depending on how the user entered the privdata,
+-- and which version of propellor stored it. Use the accessor functions
+-- below to avoid newline problems.
+newtype PrivData = PrivData String
+
+-- | When PrivData is the content of a file, this is the lines thereof.
+privDataLines :: PrivData -> [String]
+privDataLines (PrivData s) = lines s
+
+-- | When the PrivData is a single value, like a password, this extracts
+-- it. Note that if multiple lines are present in the PrivData, only
+-- the first is returned; there is never a newline in the String.
+privDataVal :: PrivData -> String
+privDataVal (PrivData s) = fromMaybe "" (headMaybe (lines s))
data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
deriving (Read, Show, Ord, Eq, Enum, Bounded)