Better error reporting on unsupported packet.

3 files changed, 55 insertions, 2 deletions

diff --git a/kiki.cabal b/kiki.cabal
index d164441..edd8962 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -102,7 +102,8 @@ library
                      Compat,
                      PacketTranscoder,
                      Transforms,
-                     Data.OpenPGP.Util
+                     Data.OpenPGP.Util,
+                     Text.XXD
     Build-Depends:   base >=4.6.0.0,
                      openpgp-asciiarmor,
                      asn1-encoding,
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 234d2ef..8e54127 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -40,7 +40,8 @@ import qualified Data.ByteString            as S (ByteString, breakSubstring,
 import           Data.ByteString.Lazy       (ByteString)
 import qualified Data.ByteString.Lazy       as L (ByteString, concat, empty,
                                                   fromChunks, hGetContents,
-                                                  null, readFile, toChunks)
+                                                  null, readFile, toChunks,
+                                                  toStrict)
 import           Data.Char
 import           Data.Function
 import           Data.List
@@ -118,6 +119,7 @@ import           Transforms
 import           PacketTranscoder
 import           GnuPGAgent
 import           ByteStringUtil
+import           Text.XXD
 
 -- | buildKeyDB
 --
@@ -661,6 +663,8 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
       where
         update Nothing   = Just $ KeyData (mappedPacketWithHint filename p n) [] Map.empty Map.empty
         update (Just kd) = dbInsertPacket kd filename adding
+    mergeit _  (_,(_,_,(UnsupportedPacket tag bytes,_)))
+                           = error $ unlines $ ("Unsupported packet type "++show tag) : xxd 0 (L.toStrict bytes)
     mergeit _  (_,(_,_,p)) = error $ "Unexpected PGP packet 3: "++whatP p
 
     whatP (a,_) = concat . take 1 . words . show $ a
diff --git a/lib/Text/XXD.hs b/lib/Text/XXD.hs
new file mode 100644
index 0000000..77606bf
--- /dev/null
+++ b/lib/Text/XXD.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Text.XXD (xxd, xxd2) where
+
+import Data.ByteArray (ByteArrayAccess)
+import qualified Data.ByteArray as BA
+import Data.Word
+import Data.Bits
+import Data.Char
+import Text.Printf
+
+nibble :: Word8 -> Char
+nibble b = intToDigit (fromIntegral (b .&. 0x0F))
+
+nibbles :: ByteArrayAccess ba => ba -> String
+nibbles xs = unwords $ map (\byte -> [nibble (byte `shiftR` 4), nibble byte])
+                     $ BA.unpack xs
+
+xxd0 :: (ByteArrayAccess ba) => (forall b. ByteArrayAccess b => b -> String) -> Int -> ba -> [String]
+xxd0 tr offset bs | BA.null bs = []
+xxd0 tr offset bs              = printf "%03x: %s%s" offset (nibbles xs) (tr xs)
+                                 : xxd0 tr (offset + BA.length xs) bs'
+ where
+    (xs,bs') = splitAtView 16 bs
+
+splitAtView :: (ByteArrayAccess ba) => Int -> ba -> (BA.View ba, BA.View ba)
+splitAtView n bs = (BA.takeView bs n, BA.dropView bs n)
+
+xxd :: ByteArrayAccess a => Int -> a -> [String]
+xxd = xxd0 (const "")
+
+-- | like xxd, but also shows ascii
+xxd2 :: ByteArrayAccess a => Int -> a -> [String]
+xxd2 = xxd0 withAscii
+
+withAscii :: ByteArrayAccess a => a -> [Char]
+withAscii row = replicate (50 - 3 * BA.length row) ' ' ++ myunpack row
+    where
+        myunpack s = map word8tochar (BA.unpack s)
+            where word8tochar w | (w .&. 0x80 /= 0) = '.'
+                  word8tochar w = let c = chr (fromIntegral w)
+                                      in if isPrint c then c else '.'
+
+{-
+main = do
+    bs <- B.getContents
+    mapM_ putStrLn $ xxd2 0 bs
+    -}