diff options
author | Joe Crayne <joe@jerkface.net> | 2019-07-01 23:16:32 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-07-01 23:16:32 -0400 |
commit | 5d5ce0e97107619b8e33c76585d7629f106ad3c8 (patch) | |
tree | 3492c9de1a740154654a6ba1cced90e879f47219 | |
parent | ae8792ee7c51da15e52f30475c17ce589f940509 (diff) |
New debugging option: --trace-verify
-rw-r--r-- | kiki.cabal | 8 | ||||
-rw-r--r-- | kiki.hs | 9 | ||||
-rw-r--r-- | lib/Data/OpenPGP/Util.hs | 37 | ||||
-rw-r--r-- | lib/Kiki.hs | 5 | ||||
-rw-r--r-- | testkiki/testkiki.hs | 12 |
5 files changed, 66 insertions, 5 deletions
@@ -99,7 +99,8 @@ library | |||
99 | ControlMaybe, | 99 | ControlMaybe, |
100 | Compat, | 100 | Compat, |
101 | PacketTranscoder, | 101 | PacketTranscoder, |
102 | Transforms | 102 | Transforms, |
103 | Data.OpenPGP.Util | ||
103 | Build-Depends: base >=4.6.0.0, | 104 | Build-Depends: base >=4.6.0.0, |
104 | asn1-encoding, | 105 | asn1-encoding, |
105 | asn1-types, | 106 | asn1-types, |
@@ -145,8 +146,11 @@ Test-suite testkiki | |||
145 | , filepath | 146 | , filepath |
146 | , bytestring | 147 | , bytestring |
147 | , time | 148 | , time |
148 | , cryptohash | ||
149 | , kiki | 149 | , kiki |
150 | if !flag(cryptonite) | ||
151 | Build-Depends: cryptohash | ||
152 | else | ||
153 | Build-Depends: cryptonite, memory | ||
150 | if flag(unixEnv) | 154 | if flag(unixEnv) |
151 | Build-depends: base < 4.7.0, unix | 155 | Build-depends: base < 4.7.0, unix |
152 | else | 156 | else |
@@ -659,6 +659,9 @@ kiki_usage bExport bImport bSecret cmd = putStr $ | |||
659 | [" --help" | 659 | [" --help" |
660 | ," Gives usage information" | 660 | ," Gives usage information" |
661 | ,"" | 661 | ,"" |
662 | ," --trace-verify" | ||
663 | ," For debugging, stderr traces for every signature verification." | ||
664 | ,"" | ||
662 | ] ++ documentHomeDir ++ [""] | 665 | ] ++ documentHomeDir ++ [""] |
663 | ++ documentPassphraseFDFlag bExport bImport bSecret | 666 | ++ documentPassphraseFDFlag bExport bImport bSecret |
664 | showwk :: [String] | 667 | showwk :: [String] |
@@ -1745,7 +1748,11 @@ commands = | |||
1745 | main :: IO () | 1748 | main :: IO () |
1746 | main = do | 1749 | main = do |
1747 | dotlock_init | 1750 | dotlock_init |
1748 | args_raw <- getArgs | 1751 | args_raw0 <- getArgs |
1752 | args_raw <- case break (=="--trace-verify") args_raw0 of | ||
1753 | (as,[]) -> return as | ||
1754 | (as,_:bs) -> do setVerifyFlag True | ||
1755 | return $ as ++ bs | ||
1749 | case args_raw of | 1756 | case args_raw of |
1750 | 1757 | ||
1751 | [] -> kiki "show" ["--working"] | 1758 | [] -> kiki "show" ["--working"] |
diff --git a/lib/Data/OpenPGP/Util.hs b/lib/Data/OpenPGP/Util.hs new file mode 100644 index 0000000..a51ce64 --- /dev/null +++ b/lib/Data/OpenPGP/Util.hs | |||
@@ -0,0 +1,37 @@ | |||
1 | {-# OPTIONS_GHC -Wno-duplicate-exports #-} | ||
2 | {-# LANGUAGE PackageImports #-} | ||
3 | module Data.OpenPGP.Util | ||
4 | ( module P | ||
5 | , verify | ||
6 | , setVerifyFlag | ||
7 | ) where | ||
8 | |||
9 | import Data.Bool | ||
10 | import Data.IORef | ||
11 | import Debug.Trace | ||
12 | import GHC.Stack | ||
13 | import System.IO.Unsafe | ||
14 | |||
15 | import qualified "openpgp-util" Data.OpenPGP.Util as P | ||
16 | import "openpgp-util" Data.OpenPGP.Util hiding (verify) | ||
17 | import Data.OpenPGP | ||
18 | |||
19 | traceVerifyFlag :: IORef Bool | ||
20 | traceVerifyFlag = unsafePerformIO $ newIORef False | ||
21 | {-# NOINLINE traceVerifyFlag #-} | ||
22 | |||
23 | getVerifyFlag :: Bool | ||
24 | getVerifyFlag = unsafePerformIO $ readIORef traceVerifyFlag | ||
25 | {-# NOINLINE getVerifyFlag #-} | ||
26 | |||
27 | setVerifyFlag :: Bool -> IO () | ||
28 | setVerifyFlag x = writeIORef traceVerifyFlag x | ||
29 | |||
30 | shortCallStack :: [([Char], SrcLoc)] -> String | ||
31 | shortCallStack [] = "" | ||
32 | shortCallStack ((_,loc):_) = (srcLocFile loc) ++ ":" ++ show (srcLocStartLine loc) | ||
33 | |||
34 | verify :: HasCallStack => Message -> SignatureOver -> SignatureOver | ||
35 | verify msg sig = | ||
36 | bool id (trace $ "verify " ++ shortCallStack (getCallStack callStack)) getVerifyFlag | ||
37 | $ P.verify msg sig | ||
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index 64e2d7d..6481b58 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -1,6 +1,9 @@ | |||
1 | {-# LANGUAGE CPP #-} | 1 | {-# LANGUAGE CPP #-} |
2 | {-# LANGUAGE OverloadedStrings #-} | 2 | {-# LANGUAGE OverloadedStrings #-} |
3 | module Kiki where | 3 | module Kiki |
4 | ( module Kiki | ||
5 | , setVerifyFlag | ||
6 | ) where | ||
4 | 7 | ||
5 | import Control.Applicative | 8 | import Control.Applicative |
6 | import Control.Arrow | 9 | import Control.Arrow |
diff --git a/testkiki/testkiki.hs b/testkiki/testkiki.hs index d588336..10487cf 100644 --- a/testkiki/testkiki.hs +++ b/testkiki/testkiki.hs | |||
@@ -24,12 +24,22 @@ import qualified Data.ByteString.Char8 as B | |||
24 | import Data.Time.Clock | 24 | import Data.Time.Clock |
25 | import Data.Time.Clock.POSIX | 25 | import Data.Time.Clock.POSIX |
26 | import Data.IORef | 26 | import Data.IORef |
27 | #if !defined(VERSION_cryptonite) | ||
27 | import Crypto.Hash.SHA1 (hash) | 28 | import Crypto.Hash.SHA1 (hash) |
29 | #else | ||
30 | import qualified Crypto.Hash | ||
31 | import Crypto.Hash.Algorithms | ||
32 | import Data.ByteArray (convert) | ||
33 | #endif | ||
28 | import System.IO.Unsafe (unsafePerformIO) | 34 | import System.IO.Unsafe (unsafePerformIO) |
29 | import ProcessUtils | 35 | import ProcessUtils |
30 | import Data.Bool | 36 | import Data.Bool |
31 | import Data.Char | 37 | import Data.Char |
32 | import KeyRing | 38 | import KeyRing hiding (try) |
39 | |||
40 | #if defined(VERSION_cryptonite) | ||
41 | hash x = convert (Crypto.Hash.hash x :: Crypto.Hash.Digest SHA1) :: B.ByteString | ||
42 | #endif | ||
33 | 43 | ||
34 | #if !MIN_VERSION_base(4,7,0) | 44 | #if !MIN_VERSION_base(4,7,0) |
35 | setEnv k v = System.Posix.Env.setEnv k v True | 45 | setEnv k v = System.Posix.Env.setEnv k v True |