summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/KeyRing/BuildKeyDB.hs6
-rw-r--r--lib/Text/XXD.hs48
2 files changed, 53 insertions, 1 deletions
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,
40import Data.ByteString.Lazy (ByteString) 40import Data.ByteString.Lazy (ByteString)
41import qualified Data.ByteString.Lazy as L (ByteString, concat, empty, 41import qualified Data.ByteString.Lazy as L (ByteString, concat, empty,
42 fromChunks, hGetContents, 42 fromChunks, hGetContents,
43 null, readFile, toChunks) 43 null, readFile, toChunks,
44 toStrict)
44import Data.Char 45import Data.Char
45import Data.Function 46import Data.Function
46import Data.List 47import Data.List
@@ -118,6 +119,7 @@ import Transforms
118import PacketTranscoder 119import PacketTranscoder
119import GnuPGAgent 120import GnuPGAgent
120import ByteStringUtil 121import ByteStringUtil
122import Text.XXD
121 123
122-- | buildKeyDB 124-- | buildKeyDB
123-- 125--
@@ -661,6 +663,8 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
661 where 663 where
662 update Nothing = Just $ KeyData (mappedPacketWithHint filename p n) [] Map.empty Map.empty 664 update Nothing = Just $ KeyData (mappedPacketWithHint filename p n) [] Map.empty Map.empty
663 update (Just kd) = dbInsertPacket kd filename adding 665 update (Just kd) = dbInsertPacket kd filename adding
666 mergeit _ (_,(_,_,(UnsupportedPacket tag bytes,_)))
667 = error $ unlines $ ("Unsupported packet type "++show tag) : xxd 0 (L.toStrict bytes)
664 mergeit _ (_,(_,_,p)) = error $ "Unexpected PGP packet 3: "++whatP p 668 mergeit _ (_,(_,_,p)) = error $ "Unexpected PGP packet 3: "++whatP p
665 669
666 whatP (a,_) = concat . take 1 . words . show $ a 670 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 @@
1{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3module Text.XXD (xxd, xxd2) where
4
5import Data.ByteArray (ByteArrayAccess)
6import qualified Data.ByteArray as BA
7import Data.Word
8import Data.Bits
9import Data.Char
10import Text.Printf
11
12nibble :: Word8 -> Char
13nibble b = intToDigit (fromIntegral (b .&. 0x0F))
14
15nibbles :: ByteArrayAccess ba => ba -> String
16nibbles xs = unwords $ map (\byte -> [nibble (byte `shiftR` 4), nibble byte])
17 $ BA.unpack xs
18
19xxd0 :: (ByteArrayAccess ba) => (forall b. ByteArrayAccess b => b -> String) -> Int -> ba -> [String]
20xxd0 tr offset bs | BA.null bs = []
21xxd0 tr offset bs = printf "%03x: %s%s" offset (nibbles xs) (tr xs)
22 : xxd0 tr (offset + BA.length xs) bs'
23 where
24 (xs,bs') = splitAtView 16 bs
25
26splitAtView :: (ByteArrayAccess ba) => Int -> ba -> (BA.View ba, BA.View ba)
27splitAtView n bs = (BA.takeView bs n, BA.dropView bs n)
28
29xxd :: ByteArrayAccess a => Int -> a -> [String]
30xxd = xxd0 (const "")
31
32-- | like xxd, but also shows ascii
33xxd2 :: ByteArrayAccess a => Int -> a -> [String]
34xxd2 = xxd0 withAscii
35
36withAscii :: ByteArrayAccess a => a -> [Char]
37withAscii row = replicate (50 - 3 * BA.length row) ' ' ++ myunpack row
38 where
39 myunpack s = map word8tochar (BA.unpack s)
40 where word8tochar w | (w .&. 0x80 /= 0) = '.'
41 word8tochar w = let c = chr (fromIntegral w)
42 in if isPrint c then c else '.'
43
44{-
45main = do
46 bs <- B.getContents
47 mapM_ putStrLn $ xxd2 0 bs
48 -}