diff options
-rw-r--r-- | kiki.cabal | 3 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 6 | ||||
-rw-r--r-- | lib/Text/XXD.hs | 48 |
3 files changed, 55 insertions, 2 deletions
@@ -102,7 +102,8 @@ library | |||
102 | Compat, | 102 | Compat, |
103 | PacketTranscoder, | 103 | PacketTranscoder, |
104 | Transforms, | 104 | Transforms, |
105 | Data.OpenPGP.Util | 105 | Data.OpenPGP.Util, |
106 | Text.XXD | ||
106 | Build-Depends: base >=4.6.0.0, | 107 | Build-Depends: base >=4.6.0.0, |
107 | openpgp-asciiarmor, | 108 | openpgp-asciiarmor, |
108 | asn1-encoding, | 109 | 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, | |||
40 | import Data.ByteString.Lazy (ByteString) | 40 | import Data.ByteString.Lazy (ByteString) |
41 | import qualified Data.ByteString.Lazy as L (ByteString, concat, empty, | 41 | import 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) | ||
44 | import Data.Char | 45 | import Data.Char |
45 | import Data.Function | 46 | import Data.Function |
46 | import Data.List | 47 | import Data.List |
@@ -118,6 +119,7 @@ import Transforms | |||
118 | import PacketTranscoder | 119 | import PacketTranscoder |
119 | import GnuPGAgent | 120 | import GnuPGAgent |
120 | import ByteStringUtil | 121 | import ByteStringUtil |
122 | import 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 #-} | ||
3 | module Text.XXD (xxd, xxd2) where | ||
4 | |||
5 | import Data.ByteArray (ByteArrayAccess) | ||
6 | import qualified Data.ByteArray as BA | ||
7 | import Data.Word | ||
8 | import Data.Bits | ||
9 | import Data.Char | ||
10 | import Text.Printf | ||
11 | |||
12 | nibble :: Word8 -> Char | ||
13 | nibble b = intToDigit (fromIntegral (b .&. 0x0F)) | ||
14 | |||
15 | nibbles :: ByteArrayAccess ba => ba -> String | ||
16 | nibbles xs = unwords $ map (\byte -> [nibble (byte `shiftR` 4), nibble byte]) | ||
17 | $ BA.unpack xs | ||
18 | |||
19 | xxd0 :: (ByteArrayAccess ba) => (forall b. ByteArrayAccess b => b -> String) -> Int -> ba -> [String] | ||
20 | xxd0 tr offset bs | BA.null bs = [] | ||
21 | xxd0 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 | |||
26 | splitAtView :: (ByteArrayAccess ba) => Int -> ba -> (BA.View ba, BA.View ba) | ||
27 | splitAtView n bs = (BA.takeView bs n, BA.dropView bs n) | ||
28 | |||
29 | xxd :: ByteArrayAccess a => Int -> a -> [String] | ||
30 | xxd = xxd0 (const "") | ||
31 | |||
32 | -- | like xxd, but also shows ascii | ||
33 | xxd2 :: ByteArrayAccess a => Int -> a -> [String] | ||
34 | xxd2 = xxd0 withAscii | ||
35 | |||
36 | withAscii :: ByteArrayAccess a => a -> [Char] | ||
37 | withAscii 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 | {- | ||
45 | main = do | ||
46 | bs <- B.getContents | ||
47 | mapM_ putStrLn $ xxd2 0 bs | ||
48 | -} | ||