Flags.hs

module Tor.Flags(
         Flag(..)
       , runDefaultMain
       --
       , getNickname
       , getOnionPort
       , getContactInfo
       , getTapDevice
       )
 where

import Data.Version hiding (Version)
import Data.Word
import System.Console.GetOpt
import System.Environment
import System.Exit
import Paths_haskell_tor

data Flag = Version
          | Help
          | OnionPort Word16
          | OutputLog FilePath
          | Nickname String
          | ContactInfo String
          | UseTapDevice String
 deriving (Eq)

options :: [OptDescr Flag]
options =
  [ Option ['v']     ["version"]    (NoArg Version)
                     "show the version number"
  , Option ['h','?'] ["help"]       (NoArg Help)
                     "show this message"
  , Option ['p']     ["onion-port"] (ReqArg (OnionPort . read) "PORT")
                     "Select what onion port to use. [default 9374]"
  , Option ['o']     ["output-log"] (ReqArg OutputLog "FILE")
                     "Select where to write log info. [default stdout]"
  , Option ['n']     ["node-nickname"] (ReqArg Nickname "STR")
                     "An (optional) nickname for this Tor node."
  , Option ['c']     ["node-contact"] (ReqArg ContactInfo "STR")
                     "An (optional) contact for this Tor node."
  , Option ['t']     ["use-tap"] (ReqArg UseTapDevice "STR")
                     "Use a direct connection to a tap device."
  ]

showHelpAndStop :: Bool -> IO ()
showHelpAndStop okgood =
  do putStrLn (usageInfo "Usage: haskell-tor [options]" options)
     exitWith (if okgood then ExitSuccess else (ExitFailure 2))

showVersionAndStop :: IO ()
showVersionAndStop =
  do putStrLn ("Haskell Tor Version " ++ showVersion version)
     exitWith ExitSuccess

runDefaultMain :: ([Flag] -> IO ()) -> IO ()
runDefaultMain runNode =
  do args <- getArgs
     case getOpt Permute options args of
       (opts, [], [])
         | Version `elem` opts -> showVersionAndStop
         | Help    `elem` opts -> showHelpAndStop True
         | otherwise           -> runNode opts
       (_, _, _)               -> showHelpAndStop False

-- -----------------------------------------------------------------------------

getNickname :: [Flag] -> String
getNickname []                  = ""
getNickname (Nickname x : _)    = x
getNickname (_          : rest) = getNickname rest

getOnionPort :: [Flag] -> Word16
getOnionPort []                   = 9002 -- http://xkcd.com/221/
getOnionPort (OnionPort p : _)    = p
getOnionPort (_           : rest) = getOnionPort rest

getContactInfo :: [Flag] -> Maybe String
getContactInfo []                      = Nothing
getContactInfo (ContactInfo ci : _)    = Just ci
getContactInfo (_              : rest) = getContactInfo rest

getTapDevice :: [Flag] -> Maybe String
getTapDevice []                      = Nothing
getTapDevice (UseTapDevice t : _)    = Just t
getTapDevice (_              : rest) = getTapDevice rest