From 0daf924b43d0750b285a5e857eb9946a9a71e6cc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 7 Mar 2016 18:40:24 -0400 Subject: privdata/relocate better than symlinks because this way no conflict can ever occur and, commit from hook --- src/Propellor/Git/VerifiedBranch.hs | 3 +- src/Propellor/Gpg.hs | 56 ++++++++++++++++++++----------------- src/Propellor/PrivData.hs | 7 +++-- src/Propellor/PrivData/Paths.hs | 20 +++++++++++-- 4 files changed, 55 insertions(+), 31 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Git/VerifiedBranch.hs b/src/Propellor/Git/VerifiedBranch.hs index a39bc7e9..51fcb573 100644 --- a/src/Propellor/Git/VerifiedBranch.hs +++ b/src/Propellor/Git/VerifiedBranch.hs @@ -2,7 +2,6 @@ module Propellor.Git.VerifiedBranch where import Propellor.Base import Propellor.Git -import Propellor.Gpg import Propellor.PrivData.Paths import Utility.FileMode @@ -14,6 +13,7 @@ import Utility.FileMode verifyOriginBranch :: String -> IO Bool verifyOriginBranch originbranch = do let gpgconf = privDataDir "gpg.conf" + keyring <- privDataKeyring writeFile gpgconf $ unlines [ " keyring " ++ keyring , "no-auto-check-trustdb" @@ -38,6 +38,7 @@ fetchOrigin = do oldsha <- getCurrentGitSha1 branchref + keyring <- privDataKeyring whenM (doesFileExist keyring) $ ifM (verifyOriginBranch originbranch) ( do diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs index a13734b4..55d89d29 100644 --- a/src/Propellor/Gpg.hs +++ b/src/Propellor/Gpg.hs @@ -1,7 +1,6 @@ module Propellor.Gpg where import System.IO -import System.FilePath import System.Directory import Data.Maybe import Data.List.Utils @@ -30,22 +29,21 @@ getGpgBin = do Nothing -> getEnvDefault "GNUPGBIN" "gpg" Just b -> return b -keyring :: FilePath -keyring = privDataDir "keyring.gpg" - -- Lists the keys in propellor's keyring. listPubKeys :: IO [KeyId] listPubKeys = do gpgbin <- getGpgBin - parse . lines <$> readProcess gpgbin listopts + keyring <- privDataKeyring + parse . lines <$> readProcess gpgbin (listopts keyring) where - listopts = useKeyringOpts ++ ["--with-colons", "--list-public-keys"] + listopts keyring = useKeyringOpts keyring ++ + ["--with-colons", "--list-public-keys"] parse = mapMaybe (keyIdField . split ":") keyIdField ("pub":_:_:_:f:_) = Just f keyIdField _ = Nothing -useKeyringOpts :: [String] -useKeyringOpts = +useKeyringOpts :: FilePath -> [String] +useKeyringOpts keyring = [ "--options" , "/dev/null" , "--no-default-keyring" @@ -55,20 +53,21 @@ useKeyringOpts = addKey :: KeyId -> IO () addKey keyid = do gpgbin <- getGpgBin + keyring <- privDataKeyring exitBool =<< allM (uncurry actionMessage) - [ ("adding key to propellor's keyring", addkeyring gpgbin) + [ ("adding key to propellor's keyring", addkeyring keyring gpgbin) , ("staging propellor's keyring", gitAdd keyring) , ("updating encryption of any privdata", reencryptPrivData) , ("configuring git commit signing to use key", gitconfig gpgbin) , ("committing changes", gitCommitKeyRing "add-key") ] where - addkeyring gpgbin' = do + addkeyring keyring' gpgbin' = do createDirectoryIfMissing True privDataDir boolSystem "sh" [ Param "-c" , Param $ gpgbin' ++ " --export " ++ keyid ++ " | gpg " ++ - unwords (useKeyringOpts ++ ["--import"]) + unwords (useKeyringOpts keyring' ++ ["--import"]) ] gitconfig gpgbin' = ifM (snd <$> processTranscript gpgbin' ["--list-secret-keys", keyid] Nothing) @@ -85,16 +84,17 @@ addKey keyid = do rmKey :: KeyId -> IO () rmKey keyid = do gpgbin <- getGpgBin + keyring <- privDataKeyring exitBool =<< allM (uncurry actionMessage) - [ ("removing key from propellor's keyring", rmkeyring gpgbin) + [ ("removing key from propellor's keyring", rmkeyring keyring gpgbin) , ("staging propellor's keyring", gitAdd keyring) , ("updating encryption of any privdata", reencryptPrivData) , ("configuring git commit signing to not use key", gitconfig) , ("committing changes", gitCommitKeyRing "rm-key") ] where - rmkeyring gpgbin' = boolSystem gpgbin' $ - (map Param useKeyringOpts) ++ + rmkeyring keyring' gpgbin' = boolSystem gpgbin' $ + (map Param (useKeyringOpts keyring')) ++ [ Param "--batch" , Param "--yes" , Param "--delete-key", Param keyid @@ -110,12 +110,14 @@ rmKey keyid = do ) reencryptPrivData :: IO Bool -reencryptPrivData = ifM (doesFileExist privDataFile) - ( do - gpgEncrypt privDataFile =<< gpgDecrypt privDataFile - gitAdd privDataFile - , return True - ) +reencryptPrivData = do + f <- privDataFile + ifM (doesFileExist f) + ( do + gpgEncrypt f =<< gpgDecrypt f + gitAdd f + , return True + ) gitAdd :: FilePath -> IO Bool gitAdd f = boolSystem "git" @@ -125,17 +127,21 @@ gitAdd f = boolSystem "git" gitCommitKeyRing :: String -> IO Bool gitCommitKeyRing action = do + keyring <- privDataKeyring + privdata <- privDataFile -- Commit explicitly the keyring and privdata files, as other -- changes may be staged by the user and shouldn't be committed. - tocommit <- filterM doesFileExist [ privDataFile, keyring] + tocommit <- filterM doesFileExist [ privdata, keyring] gitCommit (Just ("propellor " ++ action)) (map File tocommit) -- Adds --gpg-sign if there's a keyring. gpgSignParams :: [CommandParam] -> IO [CommandParam] -gpgSignParams ps = ifM (doesFileExist keyring) - ( return (ps ++ [Param "--gpg-sign"]) - , return ps - ) +gpgSignParams ps = do + keyring <- privDataKeyring + ifM (doesFileExist keyring) + ( return (ps ++ [Param "--gpg-sign"]) + , return ps + ) -- Automatically sign the commit if there'a a keyring. gitCommit :: Maybe String -> [CommandParam] -> IO Bool diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index ac7b00d3..bc09f0c6 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -251,12 +251,13 @@ modifyPrivData' f = do makePrivDataDir m <- decryptPrivData let (m', r) = f m - gpgEncrypt privDataFile (show m') - void $ boolSystem "git" [Param "add", File privDataFile] + privdata <- privDataFile + gpgEncrypt privdata (show m') + void $ boolSystem "git" [Param "add", File privdata] return r decryptPrivData :: IO PrivMap -decryptPrivData = readPrivData <$> gpgDecrypt privDataFile +decryptPrivData = readPrivData <$> (gpgDecrypt =<< privDataFile) readPrivData :: String -> PrivMap readPrivData = fromMaybe M.empty . readish diff --git a/src/Propellor/PrivData/Paths.hs b/src/Propellor/PrivData/Paths.hs index 3d0d8a58..7410370b 100644 --- a/src/Propellor/PrivData/Paths.hs +++ b/src/Propellor/PrivData/Paths.hs @@ -1,15 +1,31 @@ module Propellor.PrivData.Paths where +import Utility.Exception import System.FilePath +import Control.Applicative +import Prelude privDataDir :: FilePath privDataDir = "privdata" -privDataFile :: FilePath -privDataFile = privDataDir "privdata.gpg" +privDataFile :: IO FilePath +privDataFile = allowRelocate $ privDataDir "privdata.gpg" + +privDataKeyring :: IO FilePath +privDataKeyring = allowRelocate $ privDataDir "keyring.gpg" privDataLocal :: FilePath privDataLocal = privDataDir "local" privDataRelay :: String -> FilePath privDataRelay host = privDataDir "relay" host + +-- Allow relocating files in privdata, by checking for a file +-- privdata/relocate, which contains the path to a subdirectory that +-- contains the files. +allowRelocate :: FilePath -> IO FilePath +allowRelocate f = reloc . lines + <$> catchDefaultIO "" (readFile (privDataDir "relocate")) + where + reloc (p:_) | not (null p) = privDataDir p takeFileName f + reloc _ = f -- cgit v1.2.3