ResolveConfParse.hs

{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module Network.DNS.ResolveConfParse
  ( ResolveConf(..)
  , parseResolveConf
  ) where

import Data.Word
import Data.Bits
import Text.ParserCombinators.Parsec
import System.Posix.Unistd (getSystemID, nodeName)

import Network.DNS.Common

-- | This is the result of parsing a resolv.conf like file. The search path is
--   either taken from a "search" line in the config, a "domain" line in the
--   config or from the domainname of the current host. If it's taken from the
--   config, the last line takes precedent. It's in a form like:
--
--   > [["london", "myorg", "org"], ["myorg", "org"]]
--
--   The maybe members are set to the found values if they are there. Otherwise
--   they are Nothing.
data ResolveConf =
  ResolveConf { resolveNameservers :: [Word32]  -- ^ a list of IPs in big-endian format
              , resolveSearch :: [[String]]  -- ^ the search path
              , resolveNdots :: Maybe Int
              , resolveTimeout :: Maybe Int
              , resolveAttempts :: Maybe Int
              } deriving (Show)

comment = do
  char '#'
  skipMany (noneOf "\n")
  return '\n'

ws = many (char ' ' <|> char '\t' <|> char '\n' <|> try comment)
sep = many (char ' ' <|> char '\t')

octet = do
  s <- many1 $ oneOf "0123456789"
  let n = (read s) :: Word32
  if n > 255
     then fail "Octet of IP address out of range"
     else return n

int = do
  s <- many1 $ oneOf "0123456789"
  return ((read s) :: Int)

nonws = many1 (noneOf " \t\n")

nameserverLine = do
  string "nameserver"
  sep
  a <- octet
  char '.'
  b <- octet
  char '.'
  c <- octet
  char '.'
  d <- octet

  let ip = htonl $ (a `shiftL` 24) .|. (b `shiftL` 16) .|. (c `shiftL` 8) .|. d

  getState >>= (\st -> setState $ st { resolveNameservers = ip : resolveNameservers st })

domainLine = do
  string "domain"
  sep
  domain <- many1 (noneOf "\n")

  getState >>= (\st -> setState $ st { resolveSearch = [splitDNSName domain] })

searchLine = do
  string "search"
  sep
  domains <- sepBy1 nonws sep

  getState >>= (\st -> setState $ st { resolveSearch = map splitDNSName domains })

optionsLine = do
  string "options"
  sep
  let optionChunk = try ndots <|> try attempts <|> try timeout <|> (nonws >> return ())
      ndots = string "ndots:" >> int >>= (\n -> getState >>= (\st -> setState $ st { resolveNdots = Just n }))
      attempts = string "attempts:" >> int >>= (\n -> getState >>= (\st -> setState $ st { resolveAttempts = Just n }))
      timeout = string "timeout:" >> int >>= (\n -> getState >>= (\st -> setState $ st { resolveTimeout = Just n }))
  sepBy optionChunk sep
  return ()

parseLine = do
  try nameserverLine <|> try domainLine <|> try optionsLine <|> try searchLine <|> (nonws >> return ())

parseResolveConf' defaultSearch = do
  ws
  sepEndBy parseLine ws
  ws
  eof
  st <- getState
  -- if resolv.conf didn't include a search path or domain line we use the
  -- default state from the domainname of the host
  let st' = if null $ resolveSearch st
               then st { resolveSearch = defaultSearch }
               else st
      st'' = if null $ resolveNameservers st
                then st' { resolveNameservers = [htonl 0x7f000001] }
                else st'
  return st''

-- | Parse a resolv.conf like file.
parseResolveConf filename = do
  -- we need to get the default search path from the domain name
  node <- getSystemID >>= return . splitDNSName . nodeName
  let defaultSearch =
        if length node < 2
           then []
           else [tail node]
  input <- readFile filename
  return $ runParser (parseResolveConf' defaultSearch) (ResolveConf [] [] Nothing Nothing Nothing) filename input