diff options
-rw-r--r-- | DNSKey.hs | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/DNSKey.hs b/DNSKey.hs new file mode 100644 index 0000000..38d336d --- /dev/null +++ b/DNSKey.hs | |||
@@ -0,0 +1,59 @@ | |||
1 | module DNSKey where | ||
2 | |||
3 | import Data.Binary | ||
4 | import Data.Binary.Get | ||
5 | import Data.Binary.Put | ||
6 | import Data.Bits | ||
7 | import qualified Data.ByteString as B | ||
8 | import qualified Data.ByteString.Lazy as L | ||
9 | import Data.Word | ||
10 | |||
11 | -- RSA n e | ||
12 | -- n = modulus | ||
13 | -- e = exponent | ||
14 | data RSA = RSA Integer Integer | ||
15 | deriving (Eq,Show) | ||
16 | |||
17 | getRSA len = do | ||
18 | elen <- do | ||
19 | tog <- get | ||
20 | case tog :: Word8 of | ||
21 | 0 -> get :: Get Word16 | ||
22 | _ -> return $ fromIntegral tog | ||
23 | ebs <- getByteString (fromIntegral elen) | ||
24 | nlen <- fmap (fromIntegral . ((-) len)) bytesRead | ||
25 | nbs <- getByteString nlen | ||
26 | let e = snd $ B.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (elen-1,0) ebs | ||
27 | n = snd $ B.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) nbs | ||
28 | return $ RSA n e | ||
29 | |||
30 | putRSA (RSA n e) = do | ||
31 | if elen > 255 || elen==0 | ||
32 | then do | ||
33 | put (0 :: Word8) | ||
34 | put (fromIntegral elen :: Word16) | ||
35 | else do | ||
36 | put (fromIntegral elen :: Word8) | ||
37 | putByteString ebs | ||
38 | putByteString nbs | ||
39 | where | ||
40 | elen = B.length ebs | ||
41 | ebs = i2bs_unsized e | ||
42 | nbs = i2bs_unsized n | ||
43 | |||
44 | -- |@i2bs_unsized i@ converts @i@ to a 'ByteString' of sufficient bytes to express the integer. | ||
45 | -- The integer must be non-negative and a zero will be encoded in one byte. | ||
46 | -- | ||
47 | -- Thanks: Thomas DuBuisson (crypto-api) | ||
48 | i2bs_unsized :: Integer -> B.ByteString | ||
49 | i2bs_unsized 0 = B.singleton 0 | ||
50 | i2bs_unsized i = B.reverse $ B.unfoldr (\i' -> if i' <= 0 then Nothing else Just (fromIntegral i', (i' `shiftR` 8))) i | ||
51 | {-# INLINE i2bs_unsized #-} | ||
52 | |||
53 | main = do | ||
54 | bs <- L.getContents | ||
55 | let rsa = runGet (getRSA (fromIntegral $ L.length bs)) bs | ||
56 | bs' = runPut (putRSA rsa) | ||
57 | rsa' = runGet (getRSA (fromIntegral $ L.length bs)) bs' | ||
58 | print rsa | ||
59 | print rsa' | ||