Add an example of a timeout being ignored to the man page.

[haeredes.git] / src / CommandLine.hs

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index 699ea97aceea436ce6abecbace894d43542984eb..b94e378e516517e5c9d116fae5fe6979876b509e 100644 (file)
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -2,46 +2,81 @@
 
 module CommandLine (
   Args(..),
-  Delegates(..),
   get_args
   )
 where
 
-import System.Console.CmdArgs
+import System.Console.CmdArgs (
+  Data,
+  Typeable,
+  (&=),
+  args,
+  auto,
+  cmdArgs,
+  def,
+  details,
+  explicit,
+  groupname,
+  help,
+  helpArg,
+  modes,
+  name,
+  program,
+  summary,
+  typ,
+  versionArg )
 
 -- Get the version from Cabal.
-import Paths_haeres (version)
+import Paths_haeredes (version)
 import Data.Version (showVersion)
 
+import Timeout (Timeout(..))
+
+-- | Description of the 'NS' mode.
 ns_description :: String
 ns_description =
   "Confirm delegation of NS records. " ++
   "This is the default mode."
 
+-- | Description of the 'MX' mode.
 mx_description :: String
 mx_description = "Confirm delegation of MX records."
 
 program_name :: String
-program_name = "haeres"
+program_name = "haeredes"
 
 my_summary :: String
 my_summary = program_name ++ "-" ++ (showVersion version)
 
+no_append_root_help :: String
+no_append_root_help =
+  "Don't append a trailing dot to DNS names"
+
+-- | Help string for the --server flag.
 server_help :: String
 server_help =
-  "IP address of server to query " ++
+  "IP address or hostname of server to query " ++
   "(will use resolv.conf if not specified)"
 
-newtype Delegates =
-  Delegates { get_delegates :: [String] }
-  deriving (Data, Show, Typeable)
-
-instance Default Delegates where
-  def = Delegates []
+-- | Help string for the --timeout flag.
+timeout_help :: String
+timeout_help =
+  "Query timeout, in seconds (default: " ++ defstr ++ ")"
+  where
+    defstr = show $ seconds (def :: Timeout)
 
+-- | The Args type represents the possible command-line options. The
+--   duplication here seems necessary; CmdArgs' magic requires us to
+--   define some things explicitly.
 data Args =
-  NS { server :: Maybe String, delegates :: Delegates } |
-  MX { server :: Maybe String, delegates :: Delegates }
+  NS { no_append_root :: Bool,
+       server :: Maybe String,
+       timeout :: Timeout,
+       delegates :: [String] } |
+  MX { no_append_root :: Bool,
+       server :: Maybe String,
+       timeout :: Timeout,
+       delegates :: [String] }
   deriving (Data, Show, Typeable)
 
 arg_spec :: Args
@@ -58,28 +93,45 @@ arg_spec =
                    name "v",
                    groupname "Common flags"]
   where
-    -- The repetition here is necessary, some Template Haskell magic
-    -- going on.
+    -- The repetition here is necessary, some CmdArgs magic going on.
     ns :: Args
     ns = NS {
+           no_append_root = def
+                         &= groupname "Common flags"
+                         &= help no_append_root_help,
+
            server = def
-                  &= groupname "Common flags"
-                  &= typ "IP"
-                  &= help server_help,
+                 &= groupname "Common flags"
+                 &= typ "HOST"
+                 &= help server_help,
+
+           timeout = def
+                   &= groupname "Common flags"
+                   &= typ "SECONDS"
+                   &= help timeout_help,
 
            delegates = def
-                     &= args
-                     &= typ "DELEGATES" }
+                    &= args
+                    &= typ "DELEGATES" }
 
             &= details [ns_description]
 
     mx :: Args
     mx = MX {
+           no_append_root = def
+                         &= groupname "Common flags"
+                         &= help no_append_root_help,
+
            server = def
                  &= groupname "Common flags"
                  &= typ "IP"
                  &= help server_help,
 
+           timeout = def
+                   &= groupname "Common flags"
+                   &= typ "SECONDS"
+                   &= help timeout_help,
+
            delegates = def
                     &= args
                     &= typ "DELEGATES" }