ServerMain.hs

   1 {-# LANGUAGE CPP #-}
   2 module Main where
   3
   4 import           Control.Monad
   5 import           DDNS.Server
   6 import           DDNS.Server.EditZone
   7 import           DDNS.Server.SignReq
   8 import           Data.List
   9 import           OpenSSL
  10 import           System.Console.ParseArgs
  11 import           System.IO
  12
  13 data Options
  14     = Help
  15     | LSDir
  16     | DNSPort
  17     | HTTPSPort
  18     | AllowTransfer
  19     | Command
  20     deriving (Show, Eq, Ord)
  21
  22 arginfo :: [Arg Options]
  23 arginfo = [ Arg {
  24               argIndex = Help
  25             , argAbbr  = Just 'h'
  26             , argName  = Just "help"
  27             , argData  = Nothing
  28             , argDesc  = "print this help."
  29             }
  30           , Arg {
  31               argIndex = LSDir
  32             , argAbbr  = Just 'd'
  33             , argName  = Just "localstatedir"
  34             -- LOCALSTATEDIR will be replaced by CPP
  35             , argData  = argDataDefaulted "DIR" ArgtypeString LOCALSTATEDIR
  36             , argDesc  = "specify the local state directory (def: " ++ LOCALSTATEDIR ++ ")."
  37             }
  38           , Arg {
  39               argIndex = DNSPort
  40             , argAbbr  = Just 'p'
  41             , argName  = Just "dns-port"
  42             , argData  = argDataDefaulted "PORT" ArgtypeString "53"
  43             , argDesc  = "port to listen for DNS packets (default: 53)."
  44             }
  45           , Arg {
  46               argIndex = HTTPSPort
  47             , argAbbr  = Just 'P'
  48             , argName  = Just "https-port"
  49             , argData  = argDataDefaulted "PORT" ArgtypeString "443"
  50             , argDesc  = "port to listen for HTTPS connections (def: 443)."
  51             }
  52           , Arg {
  53               argIndex = AllowTransfer
  54             , argAbbr  = Just 'a'
  55             , argName  = Just "allow-transfer"
  56             , argData  = Nothing
  57             , argDesc  = "accept AXFR requests."
  58             }
  59           , Arg {
  60               argIndex = Command
  61             , argAbbr  = Nothing
  62             , argName  = Nothing
  63             , argData  = argDataDefaulted "COMMAND" ArgtypeString "daemon"
  64             , argDesc  = "command to the server (default: \"daemon\")."
  65             }
  66           ]
  67
  68 main :: IO ()
  69 main = withOpenSSL $
  70        do m <- parseArgsIO ArgsComplete arginfo
  71           when (gotArg m Help)
  72                    $ usageError m ""
  73
  74           let lsdir = getRequiredArg m LSDir
  75           (key, cert) <- ensureWeHaveKeypair lsdir
  76           withDB      <- ensureWeHaveDB lsdir
  77
  78           withDB $ \ db ->
  79               case getRequiredArg m Command of
  80                 "signreq"
  81                     -> signReq key cert
  82                 "editzone"
  83                     -> editZone db
  84                 _   -> usageError m ""