gpg secret keys list parsing

Note that Utility.Format.prop_idempotent_deencode does not hold
now that hex escaped characters are supported. quickcheck fails to notice
this, so I have left it as-is for now.

2 files changed, 34 insertions, 6 deletions

diff --git a/Utility/Format.hs b/Utility/Format.hs
index 97a966ac1..e7a27515e 100644
--- a/Utility/Format.hs
+++ b/Utility/Format.hs
@@ -15,7 +15,7 @@ module Utility.Format (
 ) where
 
 import Text.Printf (printf)
-import Data.Char (isAlphaNum, isOctDigit, isSpace, chr, ord)
+import Data.Char (isAlphaNum, isOctDigit, isHexDigit, isSpace, chr, ord)
 import Data.Maybe (fromMaybe)
 import Data.Word (Word8)
 import Data.List (isPrefixOf)
@@ -101,7 +101,7 @@ empty (Const "") = True
 empty _ = False
 
 {- Decodes a C-style encoding, where \n is a newline, \NNN is an octal
- - encoded character, etc.
+ - encoded character, and \xNN is a hex encoded character.
  -}
 decode_c :: FormatString -> FormatString
 decode_c [] = []
@@ -114,7 +114,12 @@ decode_c s = unescape ("", s)
 	  where
 		pair = span (/= e) v
 	isescape x = x == e
-	-- \NNN is an octal encoded character
+	handle (x:'x':n1:n2:rest)
+		| isescape x && allhex = (fromhex, rest)
+	  where
+	  	allhex = isHexDigit n1 && isHexDigit n2
+		fromhex = [chr $ readhex [n1, n2]]
+		readhex h = Prelude.read $ "0x" ++ h :: Int
 	handle (x:n1:n2:n3:rest)
 		| isescape x && alloctal = (fromoctal, rest)
 	  where
diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs
index a6b16fedd..ba391ef2a 100644
--- a/Utility/Gpg.hs
+++ b/Utility/Gpg.hs
@@ -11,6 +11,7 @@ module Utility.Gpg where
 
 import Control.Applicative
 import Control.Concurrent
+import qualified Data.Map as M
 
 import Common
 import qualified Build.SysConfig as SysConfig
@@ -23,8 +24,11 @@ import Utility.Env
 #else
 import Utility.Tmp
 #endif
+import Utility.Format (decode_c)
 
-newtype KeyIds = KeyIds { keyIds :: [String] }
+type KeyId = String
+
+newtype KeyIds = KeyIds { keyIds :: [KeyId] }
 	deriving (Ord, Eq)
 
 {- If a specific gpg command was found at configure time, use it.
@@ -138,13 +142,32 @@ pipeLazy params feeder reader = do
  - a key id, or a name; See the section 'HOW TO SPECIFY A USER ID' of
  - GnuPG's manpage.) -}
 findPubKeys :: String -> IO KeyIds
-findPubKeys for = KeyIds . parse <$> readStrict params
+findPubKeys for = KeyIds . parse . lines <$> readStrict params
   where
 	params = [Params "--with-colons --list-public-keys", Param for]
-	parse = catMaybes . map (keyIdField . split ":") . lines
+	parse = catMaybes . map (keyIdField . split ":")
 	keyIdField ("pub":_:_:_:f:_) = Just f
 	keyIdField _ = Nothing
 
+type UserId = String
+
+{- All of the user's secret keys, with their UserIds.
+ - Note that the UserId may be empty. -}
+secretKeys :: IO (M.Map KeyId UserId)
+secretKeys = M.fromList . parse . lines <$> readStrict params
+  where
+  	params = [Params "--with-colons --list-secret-keys --fixed-list-mode"]
+	parse = extract [] Nothing . map (split ":")
+	extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) =
+		extract ((keyid, decode_c userid):c) Nothing rest
+	extract c (Just keyid) rest =
+		extract ((keyid, ""):c) Nothing rest
+	extract c _ [] = c
+	extract c _ (("sec":_:_:_:keyid:_):rest) =
+		extract c (Just keyid) rest
+	extract c k (_:rest) =
+		extract c k rest
+
 {- Creates a block of high-quality random data suitable to use as a cipher.
  - It is armored, to avoid newlines, since gpg only reads ciphers up to the
  - first newline. -}