Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-dns for openSUSE:Factory checked in at 2026-11-06 19:48:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-dns (Old) and /work/SRC/openSUSE:Factory/.ghc-dns.new.3759290 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-dns" Fri Nov 6 19:48:42 2026 rev:2 rq:1395526 version:4.2.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-dns/ghc-dns.changes 2025-07-31 17:46:01.655722733 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-dns.new.3759290/ghc-dns.changes 2026-11-06 19:55:09.924119580 +0100 @@ -1,0 +2,15 @@ +Tue Oct 27 10:57:06 UTC 2026 - Peter Simons <[email protected]> + +- Update dns to version 4.2.1. + ## 4.2.1 + + - Security: decoding a domain name could consume a lot of CPU time and + memory with a crafted message (very long names or many compression + pointers). Now names longer than 255 octets and names that follow + more than 127 compression pointers are rejected. + - Security: an undecodable UDP reply (possibly spoofed) aborted the + lookup. Now it is dropped and the resolver keeps waiting. + - The TTL of negative cache entries is now capped by `maximumTTL`. + - Mailboxes are no longer stored in the domain name cache of the decoder. + +------------------------------------------------------------------- Old: ---- dns-4.2.0.tar.gz New: ---- dns-4.2.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-dns.spec ++++++ --- /var/tmp/diff_new_pack.lhcsot/_old 2026-11-06 19:55:10.938162039 +0100 +++ /var/tmp/diff_new_pack.lhcsot/_new 2026-11-06 19:55:10.942162206 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-dns # -# Copyright (c) 2023 SUSE LLC +# Copyright (c) 2026 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -20,7 +20,7 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 4.2.0 +Version: 4.2.1 Release: 0 Summary: DNS library in Haskell License: BSD-3-Clause ++++++ dns-4.2.0.tar.gz -> dns-4.2.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/dns-4.2.0/Changelog.md new/dns-4.2.1/Changelog.md --- old/dns-4.2.0/Changelog.md 2001-09-09 03:46:40.000000000 +0200 +++ new/dns-4.2.1/Changelog.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,16 @@ # ChangeLog +## 4.2.1 + +- Security: decoding a domain name could consume a lot of CPU time and + memory with a crafted message (very long names or many compression + pointers). Now names longer than 255 octets and names that follow + more than 127 compression pointers are rejected. +- Security: an undecodable UDP reply (possibly spoofed) aborted the + lookup. Now it is dropped and the resolver keeps waiting. +- The TTL of negative cache entries is now capped by `maximumTTL`. +- Mailboxes are no longer stored in the domain name cache of the decoder. + ## 4.2.0 - Switching cryptonite to crypton. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/dns-4.2.0/Network/DNS/LookupRaw.hs new/dns-4.2.1/Network/DNS/LookupRaw.hs --- old/dns-4.2.0/Network/DNS/LookupRaw.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/dns-4.2.1/Network/DNS/LookupRaw.hs 2001-09-09 03:46:40.000000000 +0200 @@ -152,13 +152,13 @@ soas = filter (SOA `isTypeOf`) $ authority ans insertNegative :: CacheConf -> Cache -> Key -> Entry -> TTL -> IO () -insertNegative _ c k v ttl = when (ttl /= 0) $ do +insertNegative CacheConf{..} c k v ttl = when (ttl /= 0) $ do ctime <- timeCurrent let tim = ctime `timeAdd` life insertCache k tim v c where life :: Seconds - life = fromIntegral ttl + life = fromIntegral (maximumTTL `min` ttl) isTypeOf :: TYPE -> ResourceRecord -> Bool isTypeOf t ResourceRecord{..} = rrtype == t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/dns-4.2.0/Network/DNS/Transport.hs new/dns-4.2.1/Network/DNS/Transport.hs --- old/dns-4.2.0/Network/DNS/Transport.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/dns-4.2.1/Network/DNS/Transport.hs 2001-09-09 03:46:40.000000000 +0200 @@ -183,12 +183,16 @@ -- to wait for the right answer, without resending the question. -- Note, this eliminates sequence mismatch as a UDP error condition, -- instead we'll time out if no matching answer arrives. + -- Undecodable datagrams (possibly spoofed) are dropped likewise. -- getAns sock = do - resp <- rcv sock - if checkResp q ident resp - then return resp - else getAns sock + eresp <- E.try $ rcv sock + case eresp of + Left (DecodeError _) -> getAns sock + Left e -> E.throwIO e + Right resp + | checkResp q ident resp -> return resp + | otherwise -> getAns sock ---------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/dns-4.2.0/Network/DNS.hs new/dns-4.2.1/Network/DNS.hs --- old/dns-4.2.0/Network/DNS.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/dns-4.2.1/Network/DNS.hs 2001-09-09 03:46:40.000000000 +0200 @@ -40,7 +40,7 @@ -- | Encoding a query or response. , module Network.DNS.Decode - -- | Decoding a qurey or response. + -- | Decoding a query or response. , module Network.DNS.IO -- | Sending and receiving. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/dns-4.2.0/dns.cabal new/dns-4.2.1/dns.cabal --- old/dns-4.2.0/dns.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/dns-4.2.1/dns.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ cabal-version: 2.0 name: dns -version: 4.2.0 +version: 4.2.1 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto <[email protected]> @@ -75,7 +75,7 @@ default-language: Haskell2010 ghc-options: -Wall build-depends: - base, + base >=4 && <5, array, async, attoparsec, @@ -110,7 +110,7 @@ build-depends: dns, dns-internal, - base, + base >=4 && <5, hspec, network @@ -130,7 +130,7 @@ dns, dns-internal, QuickCheck >=2.9, - base, + base >=4 && <5, bytestring, case-insensitive, hspec, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/dns-4.2.0/internal/Network/DNS/Decode/Parsers.hs new/dns-4.2.1/internal/Network/DNS/Decode/Parsers.hs --- old/dns-4.2.0/internal/Network/DNS/Decode/Parsers.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/dns-4.2.1/internal/Network/DNS/Decode/Parsers.hs 2001-09-09 03:46:40.000000000 +0200 @@ -457,7 +457,20 @@ -- strictly decreasing sequence, which prevents pointer loops. -- getDomain' :: Word8 -> Int -> SGet ByteString -getDomain' sep1 ptrLimit = do +getDomain' sep1 ptrLimit = fst <$> getDomainW sep1 ptrLimit 0 + +-- | RFC 1035 limits the wire length of a domain name to 255 octets. +maxDomainLength :: Int +maxDomainLength = 255 + +-- | Upper bound of compression pointers followed for a single name. +maxPointerHops :: Int +maxPointerHops = 127 + +-- | Like 'getDomain'' but also returns the wire length of the name. +-- The third argument is the number of pointers already followed. +getDomainW :: Word8 -> Int -> Int -> SGet (ByteString, Int) +getDomainW sep1 ptrLimit hops = do pos <- getPosition c <- getInt8 let n = getValue c @@ -467,26 +480,28 @@ -- target (offset). getPtr pos offset = do msg <- getInput - let parser = skipNBytes offset >> getDomain' sep1 offset + let parser = skipNBytes offset >> getDomainW sep1 offset (hops + 1) case runSGet parser msg of Left (DecodeError err) -> failSGet err Left err -> fail $ show err - Right o -> do + Right (o, _) -> do -- Cache only the presentation form decoding of domain names, -- mailboxes (e.g. SOA rname) are less frequently reused, and -- have a different presentation form, so must not share the -- same cache. when (sep1 == dot) $ - push pos (fst o) - return (fst o) + push pos o + return o getdomain pos c n - | c == 0 = return "." -- Perhaps the root domain? + | c == 0 = return (".", 1) -- Perhaps the root domain? | isPointer c = do d <- getInt8 let offset = n * 256 + d when (offset >= ptrLimit) $ failSGet "invalid name compression pointer" + when (hops >= maxPointerHops) $ + failSGet "too many name compression pointers" if sep1 /= dot then getPtr pos offset else pop offset >>= \case @@ -494,15 +509,19 @@ Just o -> return o -- As for now, extended labels have no use. -- This may change some time in the future. - | isExtLabel c = return "" + | isExtLabel c = return ("", 1) | otherwise = do hs <- unparseLabel sep1 <$> getNByteString n - ds <- getDomain' dot ptrLimit + (ds, len) <- getDomainW dot ptrLimit hops + let len' = n + 1 + len + when (len' > maxDomainLength) $ + failSGet "domain name too long" let dom = case ds of -- avoid trailing ".." "." -> hs <> "." _ -> hs <> B.singleton sep1 <> ds - push pos dom - return dom + when (sep1 == dot) $ + push pos (dom, len') + return (dom, len') getValue c = c .&. 0x3f isPointer c = testBit c 7 && testBit c 6 isExtLabel c = not (testBit c 7) && testBit c 6 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/dns-4.2.0/internal/Network/DNS/StateBinary.hs new/dns-4.2.1/internal/Network/DNS/StateBinary.hs --- old/dns-4.2.0/internal/Network/DNS/StateBinary.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/dns-4.2.1/internal/Network/DNS/StateBinary.hs 2001-09-09 03:46:40.000000000 +0200 @@ -141,7 +141,7 @@ type SGet = StateT PState (T.Parser ByteString) data PState = PState { - psDomain :: IntMap Domain + psDomain :: IntMap (Domain, Int) -- ^ with its wire length , psPosition :: Int , psInput :: ByteString , psAtTime :: Int64 @@ -167,12 +167,12 @@ failSGet "malformed or truncated input" ST.put $ PState dom pos' inp t -push :: Int -> Domain -> SGet () +push :: Int -> (Domain, Int) -> SGet () push n d = do PState dom pos inp t <- ST.get ST.put $ PState (IM.insert n d dom) pos inp t -pop :: Int -> SGet (Maybe Domain) +pop :: Int -> SGet (Maybe (Domain, Int)) pop n = ST.gets (IM.lookup n . psDomain) ---------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/dns-4.2.0/internal/Network/DNS/Types/Internal.hs new/dns-4.2.1/internal/Network/DNS/Types/Internal.hs --- old/dns-4.2.0/internal/Network/DNS/Types/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/dns-4.2.1/internal/Network/DNS/Types/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1080,7 +1080,7 @@ show usage ++ " " ++ show selector ++ " " ++ show mtype ++ " " ++ _b16encode digest showCAA flags tag value = - show flags ++ " " ++ BS.unpack (CI.original tag) ++ " " ++ show value + show flags ++ " " ++ BS.unpack (CI.original tag) ++ " " ++ showTXT value -- | Opaque RData: <https://tools.ietf.org/html/rfc3597#section-5> showOpaque bs = unwords ["\\#", show (BS.length bs), _b16encode bs] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/dns-4.2.0/test/DecodeSpec.hs new/dns-4.2.1/test/DecodeSpec.hs --- old/dns-4.2.0/test/DecodeSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/dns-4.2.1/test/DecodeSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -82,6 +82,14 @@ case decode (BC.init $ encode defaultQuery) of Left (DecodeError {}) -> True _ -> error "Excess input not detected" + it "accepts a name of 255 octets" $ + case decode (queryWithLabels 127) of + Right _ -> True + Left err -> error $ "Unexpected error: " ++ show err + it "rejects a name longer than 255 octets" $ + case decode (queryWithLabels 128) of + Left (DecodeError {}) -> True + _ -> error "Too long name not detected" it "soa mailbox presentation form" $ case encode test_soa_in of enc | enc /= fromHexString test_soa_bytes @@ -92,6 +100,12 @@ -> error $ "Wrong decode of test_soa: " ++ show m | otherwise -> True +-- A query whose qname consists of n one-octet labels. +queryWithLabels :: Int -> ByteString +queryWithLabels n = + BC.pack $ "\0\0\1\0\0\1\0\0\0\0\0\0" + ++ concat (replicate n "\1a") ++ "\0" ++ "\0\1\0\1" + tripleDecodeTest :: ByteString -> IO () tripleDecodeTest hexbs = ecase (decode $ fromHexString hexbs) fail' $ \ x1 ->
