diff options
author | joe <joe@jerkface.net> | 2016-08-29 01:15:25 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2016-08-29 01:15:25 -0400 |
commit | 1eff837423de69ece2a85430a7ad433b7c1a504a (patch) | |
tree | c2c7d6e83e9589de72b29924f6cb2354107d0d0e /lib/GnuPGAgent.hs | |
parent | 7a579e7b82a2f5707af77f4a7101ce72e57635ac (diff) |
Better gpg-agent support.
Diffstat (limited to 'lib/GnuPGAgent.hs')
-rw-r--r-- | lib/GnuPGAgent.hs | 23 |
1 files changed, 12 insertions, 11 deletions
diff --git a/lib/GnuPGAgent.hs b/lib/GnuPGAgent.hs index 4a0e8c8..5878357 100644 --- a/lib/GnuPGAgent.hs +++ b/lib/GnuPGAgent.hs | |||
@@ -60,15 +60,15 @@ percentPlusEscape :: String -> String | |||
60 | percentPlusEscape s = do | 60 | percentPlusEscape s = do |
61 | c <- s | 61 | c <- s |
62 | case c of | 62 | case c of |
63 | ' ' -> "+" | 63 | ' ' -> "+" |
64 | '+' -> "%2B" | 64 | '+' -> "%2B" |
65 | '"' -> "%22" | 65 | '"' -> "%22" |
66 | '%' -> "%25" | 66 | '%' -> "%25" |
67 | _ | c < ' ' -> printf "%%%02X" (ord c) | 67 | _ | c < ' ' -> printf "%%%02X" (ord c) |
68 | _ -> return c | 68 | _ -> return c |
69 | 69 | ||
70 | clearPassphrase agent key = do | 70 | clearPassphrase agent key = do |
71 | let cmd = "clear_passphrase "++fingerprint key | 71 | let cmd = "clear_passphrase --mode=normal "++fingerprint key |
72 | hPutStrLn (agentHandle agent) cmd | 72 | hPutStrLn (agentHandle agent) cmd |
73 | 73 | ||
74 | data Query = Query | 74 | data Query = Query |
@@ -78,21 +78,22 @@ data Query = Query | |||
78 | } | 78 | } |
79 | deriving Show | 79 | deriving Show |
80 | 80 | ||
81 | data QueryMode = AskNot | AskAgain String | Ask | 81 | data QueryMode = AskNot | AskAgain String | AskExisting | AskNew |
82 | deriving (Show,Eq,Ord) | 82 | deriving (Show,Eq,Ord) |
83 | 83 | ||
84 | getPassphrase :: GnuPGAgent -> QueryMode -> Query -> IO (Maybe String) | 84 | getPassphrase :: GnuPGAgent -> QueryMode -> Query -> IO (Maybe String) |
85 | getPassphrase agent ask (Query key uid masterkey) = do | 85 | getPassphrase agent ask (Query key uid masterkey) = do |
86 | let (er0,pr,desc) = prompts key uid masterkey | 86 | let (er0,pr,desc) = prompts key uid masterkey |
87 | (er,askopt) = case ask of | 87 | (er,askopt) = case ask of |
88 | AskNot -> (er0,"--no-ask") | 88 | AskNot -> (er0,"--no-ask ") |
89 | AskAgain ermsg -> (ermsg,"") | 89 | AskAgain ermsg -> (ermsg,"") |
90 | Ask -> (er0,"") | 90 | AskExisting -> (er0,"") |
91 | AskNew -> (er0,"--repeat=1 ") | ||
91 | cmd = "get_passphrase "++askopt++fingerprint key++" "++unwords (map percentPlusEscape [er,pr,desc]) | 92 | cmd = "get_passphrase "++askopt++fingerprint key++" "++unwords (map percentPlusEscape [er,pr,desc]) |
92 | -- putStrLn cmd | 93 | hPutStrLn stderr $ "gpg-agent <- " ++ cmd |
93 | hPutStrLn (agentHandle agent) cmd | 94 | hPutStrLn (agentHandle agent) cmd |
94 | r0 <- hGetLine (agentHandle agent) | 95 | r0 <- hGetLine (agentHandle agent) |
95 | -- putStrLn $ "agent says: " ++ r0 | 96 | -- hPutStrLn stderr $ "agent says: " ++ r0 |
96 | case takeWhile (/=' ') r0 of | 97 | case takeWhile (/=' ') r0 of |
97 | "OK" -> hGetLine (agentHandle agent) >>= unhex . drop 3 | 98 | "OK" -> hGetLine (agentHandle agent) >>= unhex . drop 3 |
98 | where | 99 | where |