diff options
Diffstat (limited to 'src/Network/QueryResponse.hs')
-rw-r--r-- | src/Network/QueryResponse.hs | 15 |
1 files changed, 13 insertions, 2 deletions
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs index 4e697109..3ee6d945 100644 --- a/src/Network/QueryResponse.hs +++ b/src/Network/QueryResponse.hs | |||
@@ -37,6 +37,7 @@ import System.Endian | |||
37 | import System.IO | 37 | import System.IO |
38 | import System.IO.Error | 38 | import System.IO.Error |
39 | import System.Timeout | 39 | import System.Timeout |
40 | import DPut | ||
40 | 41 | ||
41 | -- | Three methods are required to implement a datagram based query\/response protocol. | 42 | -- | Three methods are required to implement a datagram based query\/response protocol. |
42 | data Transport err addr x = Transport | 43 | data Transport err addr x = Transport |
@@ -426,6 +427,16 @@ ignoreErrors = ErrorReporter | |||
426 | , reportTimeout = \_ _ _ -> return () | 427 | , reportTimeout = \_ _ _ -> return () |
427 | } | 428 | } |
428 | 429 | ||
430 | logErrors :: ( Show addr | ||
431 | , Show meth | ||
432 | ) => ErrorReporter addr x meth tid String | ||
433 | logErrors = ErrorReporter | ||
434 | { reportParseError = \err -> dput XMisc err | ||
435 | , reportMissingHandler = \meth addr x -> dput XMisc $ show addr ++ " --> Missing handler ("++show meth++")" | ||
436 | , reportUnknown = \addr x err -> dput XMisc $ show addr ++ " --> " ++ err | ||
437 | , reportTimeout = \meth tid addr -> dput XMisc $ show addr ++ " --> Timeout ("++show meth++")" | ||
438 | } | ||
439 | |||
429 | printErrors :: ( Show addr | 440 | printErrors :: ( Show addr |
430 | , Show meth | 441 | , Show meth |
431 | ) => Handle -> ErrorReporter addr x meth tid String | 442 | ) => Handle -> ErrorReporter addr x meth tid String |
@@ -550,9 +561,9 @@ udpTransport' bind_address = do | |||
550 | (SockAddrInet6 port 0 (0,0,0x0000ffff,raw4) 0) -> \bs -> do | 561 | (SockAddrInet6 port 0 (0,0,0x0000ffff,raw4) 0) -> \bs -> do |
551 | let host4 = toBE32 raw4 | 562 | let host4 = toBE32 raw4 |
552 | -- Change 4mapped6 to ordinary IPv4. | 563 | -- Change 4mapped6 to ordinary IPv4. |
553 | -- hPutStrLn stderr $ "4mapped6 -> "++show (SockAddrInet port host4) | 564 | -- dput XMisc $ "4mapped6 -> "++show (SockAddrInet port host4) |
554 | saferSendTo sock bs (SockAddrInet port host4) | 565 | saferSendTo sock bs (SockAddrInet port host4) |
555 | addr@(SockAddrInet6 {}) -> \bs -> hPutStrLn stderr ("Discarding packet to "++show addr) | 566 | addr@(SockAddrInet6 {}) -> \bs -> dput XMisc ("Discarding packet to "++show addr) |
556 | addr4 -> \bs -> saferSendTo sock bs addr4 | 567 | addr4 -> \bs -> saferSendTo sock bs addr4 |
557 | _ -> \addr bs -> saferSendTo sock bs addr | 568 | _ -> \addr bs -> saferSendTo sock bs addr |
558 | , closeTransport = close sock | 569 | , closeTransport = close sock |