kazu-yamamoto/dns
1
1
Fork 0
mirror of https://github.com/kazu-yamamoto/dns.git synced 2024-10-06 10:40:07 +03:00
Code Issues Projects Releases Wiki Activity

Implemented NSEC3 decode, encode and show

Browse Source 
- Also added the "CAA" TYPE, which then displays more
  usably in NSEC/NSEC3 type bitmaps.

- We are already using base64-bytestring, and since base16-bytestring
  presents no issues, and simpler interface than ByteString.Builder,
  switched hex encoding to use base16-bytestring (new dependency).

- To avoid a fragile base32-bytestring dependency (the cbits for
  that code use non-portable bswap32 interfaces), implemented
  Base32hex directly with mutable arrays.  We don't need a highly
  performant version, this is only used for the "Show" instance of
  NSEC3 RData, most users will never evaluate this code.
This commit is contained in:
Viktor Dukhovni 2018-10-28 07:50:16 -04:00
parent 4f81d380dc
commit b3b77e587a
9 changed files with 120 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Changelog.md
View File

@ -1,5 +1,8 @@
# 4.0.0
- Added the TYPE definition, but not yet RData, for CAA.
- Added decode, encode and show for NSEC3 RRs.
- Added base16-bytestring as a new dependency.
- Added decode, encode and show for NSEC RRs.
- New RData constructor RD_NSEC.
- Correct presentation form of unknown RR types.

50
Network/DNS/Base32Hex.hs Normal file
View File

@ -0,0 +1,50 @@
module Network.DNS.Base32Hex (encode) where
import Control.Monad (when)
import qualified Data.Array.MArray as A
import qualified Data.Array.IArray as A
import qualified Data.Array.ST as A
import qualified Data.ByteString as B
import Data.Bits
-- | Encode ByteString using the
-- <https://tools.ietf.org/html/rfc4648#section-7 RFC4648 base32hex>
-- encoding with no padding as specified for the
-- <https://tools.ietf.org/html/rfc5155#section-3.3 RFC5155 Next Hashed Owner Name>
-- field.
--
encode :: B.ByteString -- ^ input buffer
-> B.ByteString -- ^ base32hex output
encode bs =
let len = (8 * B.length bs + 4) `div` 5
ws = B.unpack bs
in B.pack $ A.elems $ A.runSTUArray $ do
a <- A.newArray (0 :: Int, len-1) 0
go ws a 0
where
toHex32 w | w < 10 = 48 + w
| otherwise = 55 + w
load8 a i = A.readArray a i
store8 a i v = A.writeArray a i v
-- Encode a list of 8-bit words at bit offset @n@
-- into an array 'a' of 5-bit words.
go [] a _ = A.mapArray toHex32 a
go (w:ws) a n = do
-- Split 8 bits into left, middle and right parts. The
-- right part only gets written when the 8-bit input word
-- splits across three different 5-bit words.
--
let (q, r) = n `divMod` 5
wl = w `shiftR` ( 3 + r)
wm = (w `shiftL` ( 5 - r)) `shiftR` 3
wr = (w `shiftL` (10 - r)) `shiftR` 3
al <- case r of
0 -> pure wl
_ -> (wl .|.) <$> load8 a q
store8 a q al
store8 a (q + 1) wm
when (r > 2) $ store8 a (q+2) wr
go ws a $ n + 8
{-# INLINE encode #-}

10
Network/DNS/Decode/Parsers.hs
View File

@ -236,6 +236,16 @@ getRData DNSKEY len = RD_DNSKEY <$> decodeKeyFlags
decodeKeyAlg = get8
decodeKeyBytes = getNByteString (len - 4)
--
getRData NSEC3 len = do
dend <- rdataEnd len
halg <- get8
flgs <- get8
iter <- get16
salt <- getInt8 >>= getNByteString
hash <- getInt8 >>= getNByteString
tpos <- getPosition
RD_NSEC3 halg flgs iter salt hash <$> getNsecTypes (dend - tpos)
--
getRData NSEC3PARAM _ = RD_NSEC3PARAM <$> decodeHashAlg
<*> decodeFlags
<*> decodeIterations

9
Network/DNS/Encode.hs
View File

@ -168,6 +168,7 @@ putRData rd = case rd of
RD_RRSIG rrsig -> putRRSIG rrsig
RD_NSEC next types -> putDomain next <> putNsecTypes types
RD_DNSKEY f p alg key -> putDNSKEY f p alg key
RD_NSEC3 a f i s h types -> putNSEC3 a f i s h types
RD_NSEC3PARAM a f iter salt -> putNSEC3PARAM a f iter salt
RD_TLSA u s m dgst -> putTLSA u s m dgst
UnknownRData bytes -> putByteString bytes
@ -216,6 +217,14 @@ putRData rd = case rd of
, put8 alg
, putByteString key
]
putNSEC3 alg flags iterations salt hash types = mconcat
[ put8 alg
, put8 flags
, put16 iterations
, putByteStringWithLength salt
, putByteStringWithLength hash
, putNsecTypes types
]
putNSEC3PARAM alg flags iterations salt = mconcat
[ put8 alg
, put8 flags

1
Network/DNS/Memo.hs
View File

@ -72,6 +72,7 @@ copy (RD_DS t a dt dv) = RD_DS t a dt $ B.copy dv
copy (RD_NSEC dom ts) = RD_NSEC (B.copy dom) ts
copy (RD_DNSKEY f p a k) = RD_DNSKEY f p a $ B.copy k
copy (RD_TLSA a b c dgst) = RD_TLSA a b c $ B.copy dgst
copy (RD_NSEC3 a b c s h t) = RD_NSEC3 a b c (B.copy s) (B.copy h) t
copy (RD_NSEC3PARAM a b c salt) = RD_NSEC3PARAM a b c $ B.copy salt
copy (RD_RRSIG sig) = RD_RRSIG $ copysig sig
where

4
Network/DNS/StateBinary.hs
View File

@ -44,8 +44,8 @@ module Network.DNS.StateBinary (
, skipNBytes
) where
import Control.Monad.State (State, StateT)
import qualified Control.Monad.State as ST
import Control.Monad.State.Strict (State, StateT)
import qualified Control.Monad.State.Strict as ST
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.Types as T
import qualified Data.ByteString as BS

45
Network/DNS/Types.hs
View File

@ -43,6 +43,7 @@ module Network.DNS.Types (
, CDNSKEY
, CSYNC
, ANY
, CAA
)
, fromTYPE
, toTYPE
@ -137,10 +138,7 @@ module Network.DNS.Types (
import Control.Exception (Exception, IOException)
import Control.Applicative ((<|>))
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Builder as L
import qualified Data.ByteString.Lazy as L
import Data.Function (on)
import Data.IP (IP(..), IPv4, IPv6)
import qualified Data.List as List
@ -150,6 +148,10 @@ import qualified Data.Text.Format as T
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Builder as T
import qualified Data.ByteString.Base16 as B16
import qualified Network.DNS.Base32Hex as B32
import qualified Data.ByteString.Base64 as B64
import Network.DNS.Imports
-- $setup
@ -246,6 +248,9 @@ pattern CSYNC = TYPE 62 -- RFC 7477
-- | A request for all records the server/cache has available
pattern ANY :: TYPE
pattern ANY = TYPE 255
-- | A request for all records the server/cache has available
pattern CAA :: TYPE
pattern CAA = TYPE 257
-- | From number to type.
toTYPE :: Word16 -> TYPE
@ -276,6 +281,7 @@ data TYPE = A -- ^ IPv4 address
| CSYNC -- ^ Child-To-Parent Synchronization (RFC7477)
| ANY -- ^ A request for all records the server/cache
-- has available
| CAA -- ^ Certification Authority Authorization
| UnknownTYPE Word16 -- ^ Unknown type
deriving (Eq, Ord, Read)
@ -304,6 +310,7 @@ fromTYPE CDS = 59
fromTYPE CDNSKEY = 60
fromTYPE CSYNC = 62
fromTYPE ANY = 255
fromTYPE CAA = 257
fromTYPE (UnknownTYPE x) = x
-- | From number to type.
@ -331,6 +338,7 @@ toTYPE 59 = CDS
toTYPE 60 = CDNSKEY
toTYPE 62 = CSYNC
toTYPE 255 = ANY
toTYPE 257 = CAA
toTYPE x = UnknownTYPE x
#endif
@ -358,6 +366,7 @@ instance Show TYPE where
show CDNSKEY = "CDNSKEY"
show CSYNC = "CSYNC"
show ANY = "ANY"
show CAA = "CAA"
show x = "TYPE" ++ (show $ fromTYPE x)
----------------------------------------------------------------
@ -1338,8 +1347,10 @@ data RData = RD_A IPv4 -- ^ IPv4 address
| RD_NSEC Domain [TYPE] -- ^ DNSSEC denial of existence NSEC record
| RD_DNSKEY Word16 Word8 Word8 ByteString
-- ^ DNSKEY (RFC4034)
--RD_NSEC3
| RD_NSEC3 Word8 Word8 Word16 ByteString ByteString [TYPE]
-- ^ DNSSEC hashed denial of existence (RFC5155)
| RD_NSEC3PARAM Word8 Word8 Word16 ByteString
-- ^ NSEC3 zone parameters (RFC5155)
| RD_TLSA Word8 Word8 Word8 ByteString
-- ^ TLSA (RFC6698)
--RD_CDS
@ -1366,12 +1377,13 @@ instance Show RData where
RD_RRSIG rrsig -> show rrsig
RD_NSEC next types -> showNSEC next types
RD_DNSKEY f p a k -> showDNSKEY f p a k
RD_NSEC3 a f i s h types -> showNSEC3 a f i s h types
RD_NSEC3PARAM a f i s -> showNSEC3PARAM a f i s
RD_TLSA u s m d -> showTLSA u s m d
UnknownRData bytes -> showOpaque bytes
where
showSalt "" = "-"
showSalt salt = hexencode salt
showSalt salt = b16encode salt
showDomain = BS.unpack
showSOA mname mrname serial refresh retry expire minttl =
showDomain mname ++ " " ++ showDomain mrname ++ " " ++
@ -1384,25 +1396,28 @@ instance Show RData where
show port ++ BS.unpack target
showDS keytag alg digestType digest =
show keytag ++ " " ++ show alg ++ " " ++
show digestType ++ " " ++ hexencode digest
show digestType ++ " " ++ b16encode digest
showNSEC next types =
unwords $ showDomain next : map show types
showDNSKEY flags protocol alg key =
show flags ++ " " ++ show protocol ++ " " ++
show alg ++ " " ++ b64encode key
-- | <https://tools.ietf.org/html/rfc5155#section-3.2>
showNSEC3 hashalg flags iterations salt nexthash types =
unwords $ show hashalg : show flags : show iterations :
showSalt salt : b32encode nexthash : map show types
showNSEC3PARAM hashAlg flags iterations salt =
show hashAlg ++ " " ++ show flags ++ " " ++
show iterations ++ " " ++ showSalt salt
showTLSA usage selector mtype digest =
show usage ++ " " ++ show selector ++ " " ++
show mtype ++ " " ++ hexencode digest
show mtype ++ " " ++ b16encode digest
-- | Opaque RData: <https://tools.ietf.org/html/rfc3597#section-5>
showOpaque bs = unwords $ ["\\#", show (BS.length bs), hexencode bs]
showOpaque bs = unwords $ ["\\#", show (BS.length bs), b16encode bs]
hexencode :: ByteString -> String
hexencode = BS.unpack . L.toStrict . L.toLazyByteString . L.byteStringHex
b64encode :: ByteString -> String
b16encode, b32encode, b64encode :: ByteString -> String
b16encode = BS.unpack. B16.encode
b32encode = BS.unpack. B32.encode
b64encode = BS.unpack. B64.encode
-- | Type alias for resource records in the answer section.
@ -1690,14 +1705,14 @@ instance Show OData where
show (OD_N3U hs) = showAlgList "N3U" hs
show (OD_ClientSubnet b1 b2 ip@(IPv4 _)) = showECS 1 b1 b2 $ show ip
show (OD_ClientSubnet b1 b2 ip@(IPv6 _)) = showECS 2 b1 b2 $ show ip
show (OD_ECSgeneric fam b1 b2 a) = showECS fam b1 b2 $ hexencode a
show (OD_ECSgeneric fam b1 b2 a) = showECS fam b1 b2 $ b16encode a
show (UnknownOData code bs) = showUnknown code bs
showAlgList :: String -> [Word8] -> String
showAlgList nm ws = nm ++ " " ++ List.intercalate "," (map show ws)
showNSID :: ByteString -> String
showNSID nsid = "NSID" ++ " " ++ hexencode nsid ++ ";" ++ printable nsid
showNSID nsid = "NSID" ++ " " ++ b16encode nsid ++ ";" ++ printable nsid
where
printable = BS.unpack. BS.map (\c -> if c < ' ' || c > '~' then '?' else c)
@ -1707,4 +1722,4 @@ showECS family srcBits scpBits address =
++ " " ++ show scpBits ++ " " ++ address
showUnknown :: Word16 -> ByteString -> String
showUnknown code bs = "UnknownOData " ++ show code ++ " " ++ hexencode bs
showUnknown code bs = "UnknownOData " ++ show code ++ " " ++ b16encode bs

5
dns.cabal
View File

@ -32,7 +32,8 @@ Library
Network.DNS.Decode
Network.DNS.Decode.Internal
Network.DNS.IO
Other-Modules: Network.DNS.Decode.Parsers
Other-Modules: Network.DNS.Base32Hex
Network.DNS.Decode.Parsers
Network.DNS.Imports
Network.DNS.Memo
Network.DNS.StateBinary
@ -41,9 +42,11 @@ Library
if impl(ghc < 8)
Build-Depends: semigroups
Build-Depends: base >= 4 && < 5
, array
, async
, attoparsec
, auto-update
, base16-bytestring
, base64-bytestring
, binary
, bytestring

11
test/RoundTripSpec.hs
View File

@ -102,7 +102,8 @@ genResourceRecord = frequency
where
genRR = do
dom <- genDomain
t <- elements [A, AAAA, NS, TXT, MX, CNAME, SOA, PTR, SRV, DNAME, DS, TLSA, NSEC]
t <- elements [A, AAAA, NS, TXT, MX, CNAME, SOA, PTR, SRV, DNAME, DS,
TLSA, NSEC, NSEC3]
ResourceRecord dom t classIN <$> genWord32 <*> mkRData dom t
mkRData :: Domain -> TYPE -> Gen RData
@ -120,10 +121,18 @@ mkRData dom typ =
DNAME -> RD_DNAME <$> genDomain
DS -> RD_DS <$> genWord16 <*> genWord8 <*> genWord8 <*> genByteString
NSEC -> RD_NSEC <$> genDomain <*> genNsecTypes
NSEC3 -> genNSEC3
TLSA -> RD_TLSA <$> genWord8 <*> genWord8 <*> genWord8 <*> genByteString
_ -> pure . RD_TXT $ "Unhandled type " <> BS.pack (show typ)
where
genNSEC3 = do
(alg, hlen) <- elements [(1,32),(2,64)]
flgs <- elements [0,1]
iter <- elements [0..100]
salt <- elements ["", "AB"]
hash <- B.pack <$> replicateM hlen genWord8
RD_NSEC3 alg flgs iter salt hash <$> genNsecTypes
genTextString = do
len <- elements [0, 1, 63, 255, 256, 511, 512, 1023, 1024]
B.pack <$> replicateM len genWord8