packages feed

WL500gPControl-0.3.4: src/Control/Main.hs

module Main where

import System.Console.GetOpt
import System.Environment (getArgs, getProgName)
import Data.Maybe (maybe)
import Common
import Control.Monad (sequence_, zipWithM_)
import Text.Printf (printf)
import qualified Network.Asus.WL500gP as W
import Data.Either (either)
import Data.List (intersperse)
import Control.Monad.Trans (liftIO)
#ifdef UNIX
import System.Posix.Unistd (sleep)
#elif defined WIN32
import System.Win32.Process
#endif 

#ifdef UNIX
pause = sleep
#elif defined WIN32
-- Win32 sleep function uses miliseconds as argument
pause = sleep . fromIntegral . (* 1000)
#endif

data Operation = Connect 
               | Disconnect 
               | Reconnect Int
               | Status 
               | Log Int
               | ClearLog deriving (Show)

options :: [OptDescr Operation]
options = 
    [Option ['c'] ["connect"] (NoArg Connect) 
                "Connects to the WAN"
    ,Option ['d'] ["disconnect"] (NoArg Disconnect) 
                "Disconnects from the provider"
    ,Option ['r'] ["reconnect"] (OptArg (Reconnect . maybe 5 read) "S") 
                "Disconnects from WAN, waits S seconds and reconnects to the WAN"
    ,Option ['s'] ["status"] (NoArg Status) 
                "Prints the connection status"
    ,Option ['l'] ["log"] (OptArg (Log . maybe 25 read) "N") 
                "Prints last N lines from the log"
    ,Option ['x'] ["log-clear"] (NoArg ClearLog) 
                "Clears log"
    ]

-- returns the list of flags and the config filename
parseOpts :: [String] -> IO (Operation, Maybe String)
parseOpts argv = 
    case getOpt Permute options argv of
      (o, n, []) -> let creds = if null n 
                                 then Nothing 
                                 else Just (head n)
                        op = if null o 
                              then Status
                              else (head o)
                    in return (op, creds)
      (_, _, errs) -> do 
        progName <- getProgName
        cf <- defaultCredsFile
        let header = printf "Usage: %s OPERATION CREDENTIAL_FILE \n%s" 
                     progName 
                     ("Default credentials file is: " ++ cf)
        ioError (userError (concat errs ++ usageInfo header options))
     

main :: IO ()
main = do
  (oper, creds) <- getArgs >>= parseOpts
  cfname <- toCredsFile creds
  parseCredsFile creds >>= maybe 
                     (ioError $ userError $ printf "Failed to open credentials file '%s'" cfname) 
                     (switch oper)

brace :: String -> String -> W.Conn () -> W.Conn ()
brace b a c = sequence_ [liftIO $ putStrLn b, c, liftIO $ putStrLn a]

switch op conn = 
    W.withConnection conn $ 
     case op of 
       Connect -> brace "Connecting..." "Done" W.connectWan
       Disconnect -> brace "Disconnecting..." "Done" W.disconnectWan
       ClearLog -> brace "Erasing log.." "Done" W.clearLog
       Reconnect n -> brace "Reconnecting..." "Done" $ 
                      sequence_ [W.disconnectWan
                                ,liftIO (pause n >> return ())
                                ,W.connectWan]
       Status -> W.readStatus >>= liftIO . either (ioError . userError) showStatus
       Log n -> W.readLog >>= liftIO . either (ioError . userError) (showLog n)

showStatus stat = do
  printf "Connection status:\n"    
  case W.connectionStatus stat of
    W.Disconnected -> printf "\tWAN disconnected\n"
    _ -> do printf " WAN Connected\n"
            zipWithM_ printf [" IP:\t\t%s\n"
                             ," Subnet Mask:\t%s\n"
                             ," Gateway:\t%s\n"
                             ," DNS Servers:\t%s\n"
                             ] $ 
                               map ($ stat) [W.ip
                                            ,W.subnetMask
                                            ,W.defaultGateway
                                            ,concat . intersperse ", " . W.dnsServers]


showLog n = printf "%s" . unlines . reverse . take n . reverse