mirror of
https://github.com/kazu-yamamoto/dns.git
synced 2024-10-06 02:27:35 +03:00
Implemented NSEC3 decode, encode and show
- 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:
parent
4f81d380dc
commit
b3b77e587a
@ -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
50
Network/DNS/Base32Hex.hs
Normal 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 #-}
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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,26 +1396,29 @@ 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
|
||||
b64encode = BS.unpack . B64.encode
|
||||
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.
|
||||
type Answers = [ResourceRecord]
|
||||
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user