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.

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)