New debugging option: --trace-verify

5 files changed, 66 insertions, 5 deletions

diff --git a/kiki.cabal b/kiki.cabal
index 5cd9ccf..293cc30 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -99,7 +99,8 @@ library
                      ControlMaybe,
                      Compat,
                      PacketTranscoder,
-                     Transforms
+                     Transforms,
+                     Data.OpenPGP.Util
     Build-Depends:   base >=4.6.0.0,
                      asn1-encoding,
                      asn1-types,
@@ -145,8 +146,11 @@ Test-suite testkiki
                     , filepath
                     , bytestring
                     , time
-                    , cryptohash
                     , kiki
+    if !flag(cryptonite)
+      Build-Depends:  cryptohash
+    else
+      Build-Depends:  cryptonite, memory
     if flag(unixEnv)
       Build-depends: base < 4.7.0, unix
     else
diff --git a/kiki.hs b/kiki.hs
index 6be2a8d..ddfb05b 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -659,6 +659,9 @@ kiki_usage bExport bImport bSecret cmd = putStr $
                 ["     --help"
                 ,"                Gives usage information"
                 ,""
+                ,"     --trace-verify"
+                ,"                For debugging, stderr traces for every signature verification."
+                ,""
                 ] ++ documentHomeDir ++ [""]
                   ++ documentPassphraseFDFlag bExport bImport bSecret
             showwk :: [String]
@@ -1745,7 +1748,11 @@ commands =
 main :: IO ()
 main = do
     dotlock_init
-    args_raw <- getArgs
+    args_raw0 <- getArgs
+    args_raw <- case break (=="--trace-verify") args_raw0 of
+                  (as,[]) -> return as
+                  (as,_:bs) -> do setVerifyFlag True
+                                  return $ as ++ bs
     case args_raw of
 
         [] -> 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 @@
+{-# OPTIONS_GHC -Wno-duplicate-exports #-}
+{-# LANGUAGE PackageImports #-}
+module Data.OpenPGP.Util
+    ( module P
+    , verify
+    , setVerifyFlag
+    ) where
+
+import Data.Bool
+import Data.IORef
+import Debug.Trace
+import GHC.Stack
+import System.IO.Unsafe
+
+import qualified "openpgp-util" Data.OpenPGP.Util as P
+import "openpgp-util" Data.OpenPGP.Util hiding (verify)
+import Data.OpenPGP
+
+traceVerifyFlag :: IORef Bool
+traceVerifyFlag = unsafePerformIO $ newIORef False
+{-# NOINLINE traceVerifyFlag #-}
+
+getVerifyFlag :: Bool
+getVerifyFlag = unsafePerformIO $ readIORef traceVerifyFlag
+{-# NOINLINE getVerifyFlag #-}
+
+setVerifyFlag :: Bool -> IO ()
+setVerifyFlag x = writeIORef traceVerifyFlag x
+
+shortCallStack :: [([Char], SrcLoc)] -> String
+shortCallStack []          = ""
+shortCallStack ((_,loc):_) = (srcLocFile loc) ++ ":" ++ show (srcLocStartLine loc)
+
+verify :: HasCallStack => Message -> SignatureOver -> SignatureOver
+verify msg sig =
+    bool id (trace $ "verify " ++ shortCallStack (getCallStack callStack)) getVerifyFlag
+        $ 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 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Kiki where
+module Kiki
+    ( module Kiki
+    , setVerifyFlag
+    ) where
 
 import           Control.Applicative
 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
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Data.IORef
+#if !defined(VERSION_cryptonite)
 import Crypto.Hash.SHA1 (hash)
+#else
+import qualified Crypto.Hash
+import Crypto.Hash.Algorithms
+import Data.ByteArray (convert)
+#endif
 import System.IO.Unsafe (unsafePerformIO)
 import ProcessUtils
 import Data.Bool
 import Data.Char
-import KeyRing
+import KeyRing hiding (try)
+
+#if defined(VERSION_cryptonite)
+hash x = convert (Crypto.Hash.hash x :: Crypto.Hash.Digest SHA1) :: B.ByteString
+#endif
 
 #if !MIN_VERSION_base(4,7,0)
 setEnv k v = System.Posix.Env.setEnv k v True