diff options
Diffstat (limited to '')
| -rw-r--r-- | app/BahnhofDNS.hs | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/app/BahnhofDNS.hs b/app/BahnhofDNS.hs index 2111aa0..1b06dc1 100644 --- a/app/BahnhofDNS.hs +++ b/app/BahnhofDNS.hs @@ -8,6 +8,29 @@ import Network.DNS import Network.Socket import Util +mkByteString :: String -> ByteString +mkByteString = TSE.encodeUtf8 . Data.Text.pack + +ourName :: ByteString +ourName = mkByteString "ns.fynngodau.de." + +servedName :: ByteString +servedName = mkByteString "bahnhof.fynngodau.de." + +soa :: ResourceRecord +soa = ResourceRecord servedName SOA classIN 86400 $ RD_SOA + ourName -- mname + (mkByteString "ns@fynngodau.de") -- rname + 2025122800 -- serial + 86400 -- refresh + 7200 -- retry + 3600000 -- expire + 3600 -- minttl + +ns :: ResourceRecord +ns = ResourceRecord servedName NS classIN 86400 $ RD_NS ourName + + main :: IO () main = do -- general structure like sample code at https://book.realworldhaskell.org/read/sockets-and-syslog.html (for UDP server) staticData <- readData @@ -20,11 +43,18 @@ main = do -- general structure like sample code at https://book.realworldhaskell procMessages staticData sckt = do (m,ad) <- receiveFrom sckt -- Network.DNS +-- putStrLn $ show (question m) sendTo sckt (response m) ad procMessages staticData sckt where response m = encode $ case (question m) of (Question qh TXT) : _ -> queryAnswer (uid m) qh + (Question qh SOA) : _ + | qh == servedName -> makeResponse (uid m) (Question servedName SOA) [soa] + | otherwise -> m + (Question qh NS ) : _ + | qh == servedName -> makeResponse (uid m) (Question servedName NS ) [ns ] + | otherwise -> m _ -> m -- ping back question without answering it -- no other way to generate empty responses without providing a question in this library? |