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:
parent
653402c77b
commit
e4290c61d7
2 changed files with 34 additions and 6 deletions
|
@ -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
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
Loading…
Reference in a new issue