diff options
author | joe <joe@jerkface.net> | 2016-08-29 22:24:08 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2016-08-29 22:24:08 -0400 |
commit | 78c2c3753e69818aa7fd5d3a0354fea5d0fc452b (patch) | |
tree | 9f1b155c07db63d22f01e04198d00b89a109f6b9 /lib | |
parent | 63af3d0f3d149b110e172223c18afacd77a172f8 (diff) |
cokiki build fix & show --packets option.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/GnuPGAgent.hs | 3 | ||||
-rw-r--r-- | lib/KeyRing.hs | 24 | ||||
-rw-r--r-- | lib/PacketTranscoder.hs | 5 |
3 files changed, 27 insertions, 5 deletions
diff --git a/lib/GnuPGAgent.hs b/lib/GnuPGAgent.hs index 5878357..7161b92 100644 --- a/lib/GnuPGAgent.hs +++ b/lib/GnuPGAgent.hs | |||
@@ -7,7 +7,8 @@ module GnuPGAgent | |||
7 | , QueryMode(..) | 7 | , QueryMode(..) |
8 | , getPassphrase | 8 | , getPassphrase |
9 | , clearPassphrase | 9 | , clearPassphrase |
10 | , quit ) where | 10 | , quit |
11 | , key_nbits) where | ||
11 | 12 | ||
12 | import Debug.Trace | 13 | import Debug.Trace |
13 | import Control.Monad | 14 | import Control.Monad |
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index 8a23ff9..84d484d 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -114,6 +114,7 @@ module KeyRing | |||
114 | , resolveForReport | 114 | , resolveForReport |
115 | , KeyKey -- needed for Type sigs | 115 | , KeyKey -- needed for Type sigs |
116 | , makeMemoizingDecrypter | 116 | , makeMemoizingDecrypter |
117 | , showPacket | ||
117 | ) where | 118 | ) where |
118 | 119 | ||
119 | import System.Environment | 120 | import System.Environment |
@@ -1983,9 +1984,26 @@ showPacket :: Packet -> String | |||
1983 | showPacket p | isKey p = (if is_subkey p | 1984 | showPacket p | isKey p = (if is_subkey p |
1984 | then showPacket0 p | 1985 | then showPacket0 p |
1985 | else ifSecret p "----Secret-----" "----Public-----") | 1986 | else ifSecret p "----Secret-----" "----Public-----") |
1986 | ++ " "++show (key_algorithm p)++" "++fingerprint p | 1987 | ++ " "++fingerprint p |
1987 | | isUserID p = showPacket0 p ++ " " ++ show (uidkey p) | 1988 | ++ " "++show (key_algorithm p) |
1988 | | otherwise = showPacket0 p | 1989 | ++ case key_nbits p of { 0 -> ""; n -> "("++show n++")" } |
1990 | | isUserID p = showPacket0 p ++ " " ++ show (uidkey p) | ||
1991 | -- | isSignaturePacket p = showPacket0 p ++ maybe "" ((++) (" ^ signed"++sigusage p++": ")) (signature_issuer p) | ||
1992 | | isSignaturePacket p = showPacket0 p ++ maybe "" (" ^ signed: "++) (signature_issuer p) ++ sigusage p | ||
1993 | | otherwise = showPacket0 p | ||
1994 | where | ||
1995 | sigusage p = | ||
1996 | case take 1 (tagStrings p) of | ||
1997 | [] -> "" | ||
1998 | tag:_ -> " "++show tag -- "("++tag++")" | ||
1999 | where | ||
2000 | tagStrings p = usage_tags ++ flags | ||
2001 | where | ||
2002 | usage_tags = mapMaybe usage xs | ||
2003 | flags = mapMaybe (fmap usageString . keyflags) xs | ||
2004 | xs = hashed_subpackets p | ||
2005 | |||
2006 | |||
1989 | showPacket0 p = concat . take 1 $ words (show p) | 2007 | showPacket0 p = concat . take 1 $ words (show p) |
1990 | 2008 | ||
1991 | 2009 | ||
diff --git a/lib/PacketTranscoder.hs b/lib/PacketTranscoder.hs index 07f235c..6d1d9b8 100644 --- a/lib/PacketTranscoder.hs +++ b/lib/PacketTranscoder.hs | |||
@@ -19,6 +19,7 @@ import System.IO ( stderr) | |||
19 | import System.Posix.IO ( fdToHandle ) | 19 | import System.Posix.IO ( fdToHandle ) |
20 | import Text.Show.Pretty as PP ( ppShow ) | 20 | import Text.Show.Pretty as PP ( ppShow ) |
21 | import Types | 21 | import Types |
22 | import ControlMaybe (handleIO_) | ||
22 | 23 | ||
23 | -- | Merge two representations of the same key, prefering secret version | 24 | -- | Merge two representations of the same key, prefering secret version |
24 | -- because they have more information. | 25 | -- because they have more information. |
@@ -168,6 +169,7 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do | |||
168 | -- in the 'locations' field, so this would effectively | 169 | -- in the 'locations' field, so this would effectively |
169 | -- allow you to run 'decryptIt' on an unencrypted public key | 170 | -- allow you to run 'decryptIt' on an unencrypted public key |
170 | -- to obtain it's secret key. | 171 | -- to obtain it's secret key. |
172 | handleIO_ (decryptIt []) $ do | ||
171 | (pw,wants_retry) <- getpw (count,qry) | 173 | (pw,wants_retry) <- getpw (count,qry) |
172 | let wkun = fromMaybe wk $ do | 174 | let wkun = fromMaybe wk $ do |
173 | guard $ symmetric_algorithm (packet mp) /= Unencrypted | 175 | guard $ symmetric_algorithm (packet mp) /= Unencrypted |
@@ -218,11 +220,12 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do | |||
218 | | otherwise = return () | 220 | | otherwise = return () |
219 | clear | 221 | clear |
220 | let sanitizeQry qry = (fingerprint $ queryPacket qry, queryUID qry, fmap fingerprint $ queryMainKey qry) | 222 | let sanitizeQry qry = (fingerprint $ queryPacket qry, queryUID qry, fmap fingerprint $ queryMainKey qry) |
221 | putStrLn $ "(count,firsttime,ask,qry,actual_qry)="++show (count,firsttime,ask,sanitizeQry qry, sanitizeQry actual_qry) | 223 | -- putStrLn $ "(count,firsttime,ask,qry,actual_qry)="++show (count,firsttime,ask,sanitizeQry qry, sanitizeQry actual_qry) |
222 | mbpw <- getPassphrase s ask actual_qry | 224 | mbpw <- getPassphrase s ask actual_qry |
223 | quit s | 225 | quit s |
224 | return ( maybe "" S8.pack mbpw, guard (ask /= AskNew) >> Just clear ) | 226 | return ( maybe "" S8.pack mbpw, guard (ask /= AskNew) >> Just clear ) |
225 | 227 | ||
228 | -- putStrLn $ concat [show (symmetric_algorithm wk,s2k wk)," --> ",show (dest_alg,dest_s2k)] | ||
226 | if symmetric_algorithm wk == dest_alg | 229 | if symmetric_algorithm wk == dest_alg |
227 | && ( symmetric_algorithm wk == Unencrypted || s2k wk == dest_s2k ) | 230 | && ( symmetric_algorithm wk == Unencrypted || s2k wk == dest_s2k ) |
228 | then return (KikiSuccess wk) | 231 | then return (KikiSuccess wk) |