From 55ad7e25aa15549d631894d78e89a47eda8f9514 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Nov 2016 19:33:34 -0400 Subject: Improve extraction of gpg secret key id list, to work with gpg 2.1. --- src/Propellor/Gpg.hs | 43 ++++++++++++++++++++++++++++++++----------- 1 file changed, 32 insertions(+), 11 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs index b825d743..fd2fca79 100644 --- a/src/Propellor/Gpg.hs +++ b/src/Propellor/Gpg.hs @@ -33,21 +33,42 @@ getGpgBin = do listPubKeys :: IO [KeyId] listPubKeys = do keyring <- privDataKeyring - map fst <$> listKeys ("--list-public-keys" : useKeyringOpts keyring) + let listopts = + [ "--list-public-keys" + , "--with-colons" + , "--fixed-list-mode" + ] ++ useKeyringOpts keyring + gpgbin <- getGpgBin + parse . lines <$> readProcess gpgbin listopts + where + parse = mapMaybe (extract . split ":") + extract ("pub":_:_:_:f:_) = Just f + extract _ = Nothing +-- Lists all of the user's secret keys. listSecretKeys :: IO [(KeyId, String)] -listSecretKeys = listKeys ["--list-secret-keys"] - -listKeys :: [String] -> IO [(KeyId, String)] -listKeys ps = do +listSecretKeys = do gpgbin <- getGpgBin - parse . lines <$> readProcess gpgbin listopts + parse . lines <$> readProcess gpgbin + [ "--list-secret-keys" + , "--with-colons" + , "--fixed-list-mode" + ] where - listopts = ps ++ ["--with-colons"] - parse = mapMaybe (keyIdField . split ":") - keyIdField (t:_:_:_:f:_:_:_:_:n:_) - | t == "pub" || t == "sec" = Just (f, n) - keyIdField _ = Nothing + parse = extract [] Nothing . map (split ":") + extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) = + extract ((keyid, userid):c) Nothing rest + extract c (Just keyid) rest@(("sec":_):_) = + extract ((keyid, ""):c) Nothing rest + extract c (Just keyid) rest@(("pub":_):_) = + extract ((keyid, ""):c) Nothing rest + extract c (Just keyid) (_:rest) = + extract c (Just keyid) rest + extract c _ [] = c + extract c _ (("sec":_:_:_:keyid:_):rest) = + extract c (Just keyid) rest + extract c k (_:rest) = + extract c k rest useKeyringOpts :: FilePath -> [String] useKeyringOpts keyring = -- cgit v1.2.3