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.
This commit is contained in:
Joey Hess 2013-09-16 12:57:39 -04:00
parent 653402c77b
commit e4290c61d7
2 changed files with 34 additions and 6 deletions

View file

@ -15,7 +15,7 @@ module Utility.Format (
) where ) where
import Text.Printf (printf) 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.Maybe (fromMaybe)
import Data.Word (Word8) import Data.Word (Word8)
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
@ -101,7 +101,7 @@ empty (Const "") = True
empty _ = False empty _ = False
{- Decodes a C-style encoding, where \n is a newline, \NNN is an octal {- 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 :: FormatString -> FormatString
decode_c [] = [] decode_c [] = []
@ -114,7 +114,12 @@ decode_c s = unescape ("", s)
where where
pair = span (/= e) v pair = span (/= e) v
isescape x = x == e 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) handle (x:n1:n2:n3:rest)
| isescape x && alloctal = (fromoctal, rest) | isescape x && alloctal = (fromoctal, rest)
where where

View file

@ -11,6 +11,7 @@ module Utility.Gpg where
import Control.Applicative import Control.Applicative
import Control.Concurrent import Control.Concurrent
import qualified Data.Map as M
import Common import Common
import qualified Build.SysConfig as SysConfig import qualified Build.SysConfig as SysConfig
@ -23,8 +24,11 @@ import Utility.Env
#else #else
import Utility.Tmp import Utility.Tmp
#endif #endif
import Utility.Format (decode_c)
newtype KeyIds = KeyIds { keyIds :: [String] } type KeyId = String
newtype KeyIds = KeyIds { keyIds :: [KeyId] }
deriving (Ord, Eq) deriving (Ord, Eq)
{- If a specific gpg command was found at configure time, use it. {- 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 - a key id, or a name; See the section 'HOW TO SPECIFY A USER ID' of
- GnuPG's manpage.) -} - GnuPG's manpage.) -}
findPubKeys :: String -> IO KeyIds findPubKeys :: String -> IO KeyIds
findPubKeys for = KeyIds . parse <$> readStrict params findPubKeys for = KeyIds . parse . lines <$> readStrict params
where where
params = [Params "--with-colons --list-public-keys", Param for] 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 ("pub":_:_:_:f:_) = Just f
keyIdField _ = Nothing 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. {- 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 - It is armored, to avoid newlines, since gpg only reads ciphers up to the
- first newline. -} - first newline. -}