From d63a423abbfa2789024ddec4d3585d154610c958 Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Fri, 4 Nov 2016 23:42:34 +0100
Subject: initial commit

---
 loldns.hs | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 69 insertions(+)
 create mode 100644 loldns.hs

(limited to 'loldns.hs')

diff --git a/loldns.hs b/loldns.hs
new file mode 100644
index 0000000..81a1aa8
--- /dev/null
+++ b/loldns.hs
@@ -0,0 +1,69 @@
+module Main (main) where
+
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import Data.Maybe
+import Network.DNS.Decode
+import Network.DNS.Encode
+import Network.DNS.Types
+import Network.Socket.ByteString (recvFrom,sendAllTo)
+import Network.Socket hiding (recvFrom)
+import System.Environment
+import qualified Data.ByteString.Lazy as LBS
+
+import Database (Database)
+
+import qualified Config
+import qualified Database
+
+
+main :: IO ()
+main = do
+  [confPath,dbPath] <- getArgs
+  c <- Config.readFile "test.conf"
+  db <- Database.readFile "test.db"
+  addrinfos <-
+    getAddrInfo
+      (Just (defaultHints { addrFlags = [AI_PASSIVE] }))
+      Nothing
+      (Just (Config.port c))
+  addrinfo <- maybe (fail "no addr info") return (listToMaybe addrinfos)
+  bracket
+    (socket (addrFamily addrinfo) Datagram defaultProtocol)
+    (close)
+    $ \sock -> do
+      bind sock (addrAddress addrinfo)
+      forever $ do
+        (s, addr) <- recvFrom sock (Config.bufSize c)
+        forkIO $ do
+          either
+            (putStrLn . ("decode error: " ++))
+            (\req -> do
+              let res = handleRequest db req
+              sendAllTo sock (LBS.toStrict (encode res)) addr)
+            (decode (LBS.fromStrict s))
+
+handleRequest :: Database -> DNSMessage -> DNSMessage
+handleRequest db DNSMessage{question=qs,header=DNSHeader{identifier=i}} =
+    DNSMessage
+      { header = DNSHeader
+        { identifier = i
+        , flags = DNSFlags
+          { qOrR = QR_Response
+          , opcode = OP_STD
+          , authAnswer = True
+          , trunCation = False
+          , recDesired = True
+          , recAvailable = False
+          , rcode = if length as == 0 then NameErr else NoErr
+          , authenData = False
+          }
+        }
+      , question = qs
+      , answer = as
+      , authority = []
+      , additional = []
+      }
+  where
+    as = concatMap (flip Database.lookup db) qs
-- 
cgit v1.2.3