155 lines
4.7 KiB
Haskell
155 lines
4.7 KiB
Haskell
--------------------------------------------------------------------------------
|
|
-- | rofi-evpn - a prompt to dicsonnect/connect with express VPN
|
|
--
|
|
|
|
module Main (main) where
|
|
|
|
import Control.Monad
|
|
|
|
import Data.List (isPrefixOf)
|
|
import Data.List.Split
|
|
import Data.Maybe
|
|
|
|
import Rofi.Command
|
|
|
|
import System.Environment
|
|
import System.Process
|
|
|
|
main :: IO ()
|
|
main = getArgs >>= runPrompt
|
|
|
|
runPrompt :: [String] -> IO ()
|
|
runPrompt args = do
|
|
servers <- getServers
|
|
maybe (return ()) run servers
|
|
where
|
|
run (VPNStatus connected servers) = do
|
|
let d = getDisconnectAction <$> connected
|
|
let cs = fmap (getConnectAction connected) servers
|
|
runRofiIO (RofiVPNConf args) $ selectAction $ emptyMenu
|
|
{ groups =
|
|
[ untitledGroup $ toRofiActions $ maybeToList d
|
|
, untitledGroup $ toRofiActions cs
|
|
]
|
|
, prompt = Just "Select Action"
|
|
}
|
|
|
|
newtype RofiVPNConf = RofiVPNConf [String]
|
|
|
|
instance RofiConf RofiVPNConf where
|
|
defArgs (RofiVPNConf as) = as
|
|
|
|
type VPNAction = RofiAction RofiVPNConf
|
|
|
|
type VPNServer = (String, String)
|
|
|
|
data VPNStatus = VPNStatus (Maybe String) [VPNServer] deriving (Show)
|
|
|
|
getServers :: IO (Maybe VPNStatus)
|
|
getServers = do
|
|
running <- daemonIsRunning
|
|
if running
|
|
then Just <$> getStatus
|
|
else notify IconError "ExpressVPN daemon not running" >> return Nothing
|
|
|
|
getStatus :: IO VPNStatus
|
|
getStatus = do
|
|
connected <- getConnectedServer
|
|
VPNStatus connected <$> getAvailableServers
|
|
|
|
getConnectedServer :: IO (Maybe String)
|
|
getConnectedServer = (procStatus =<<) <$> readCmdSuccess eVPN ["status"] ""
|
|
where
|
|
procStatus = listToMaybe . mapMaybe procLine . lines
|
|
procLine l = case words l of
|
|
-- the output is green...
|
|
("\ESC[1;32;49mConnected":"to":server) -> Just $ unwords server
|
|
_ -> Nothing
|
|
|
|
getAvailableServers :: IO [VPNServer]
|
|
getAvailableServers = procOut =<< readCmdSuccess eVPN ["ls"] ""
|
|
where
|
|
procOut Nothing = do
|
|
notify IconError "failed to get list of servers"
|
|
return []
|
|
-- ASSUME the output has a useless header that ends in a line that starts
|
|
-- with "-----", after which is the stuff we care about, which is followed
|
|
-- by a blank line, after which there is more stuff I don't care about
|
|
procOut (Just ls) = return
|
|
$ mapMaybe (matchLine . splitOn "\t")
|
|
$ takeWhile (/= "")
|
|
$ drop 1
|
|
-- super lame way of matching lines that start with "-----"
|
|
$ dropWhile (not . isPrefixOf "-----")
|
|
$ lines ls
|
|
-- The output of this command is very strange; it is delimited (kinda) by
|
|
-- tabs but some lines are long enough that they don't have a tab. In
|
|
-- whatever case, splitting by tabs leads to variable length lists, and the
|
|
-- id is always at the front and the location is always at the end. These
|
|
-- should handle all cases.
|
|
matchLine [i, _, l] = Just (i, l)
|
|
matchLine [i, _, _, l] = Just (i, l)
|
|
matchLine [i, _, _, _, l] = Just (i, l)
|
|
matchLine _ = Nothing
|
|
|
|
daemonIsRunning :: IO Bool
|
|
daemonIsRunning = isJust <$> readCmdSuccess "pgrep" [eVPND] ""
|
|
|
|
getDisconnectAction :: String -> VPNAction
|
|
getDisconnectAction server =
|
|
("Disconnect from " ++ server, io $ void $ disconnect server)
|
|
|
|
getConnectAction :: Maybe String -> VPNServer -> VPNAction
|
|
getConnectAction connected server =
|
|
(formatServerLine server, io $ go connected)
|
|
where
|
|
go (Just c) = do
|
|
success <- disconnect c
|
|
when success con
|
|
go _ = con
|
|
con = connect server
|
|
|
|
formatServerLine :: VPNServer -> String
|
|
formatServerLine (sid, sname) = pad sid ++ " | " ++ sname
|
|
where
|
|
pad s = s ++ replicate (10 - length s) ' '
|
|
|
|
eVPN :: String
|
|
eVPN = "expressvpn"
|
|
|
|
eVPND :: String
|
|
eVPND = "expressvpnd"
|
|
|
|
connect :: VPNServer -> IO ()
|
|
connect (sid, sname) = do
|
|
res <- readCmdSuccess' eVPN ["connect", sid]
|
|
notifyIf res ("connected to " ++ sname)
|
|
("failed to connect to " ++ sname)
|
|
|
|
disconnect :: String -> IO Bool
|
|
disconnect server = do
|
|
res <- readCmdSuccess' eVPN ["disconnect"]
|
|
notifyIf res ("disconnected from " ++ server)
|
|
("failed to disconnect from " ++ server)
|
|
return res
|
|
|
|
readCmdSuccess' :: String -> [String] -> IO Bool
|
|
readCmdSuccess' cmd args = isJust <$> readCmdSuccess cmd args ""
|
|
|
|
-- TODO not DRY
|
|
data NotifyIcon = IconError | IconInfo
|
|
|
|
instance Show NotifyIcon where
|
|
show IconError = "dialog-error-symbolic"
|
|
show IconInfo = "dialog-information-symbolic"
|
|
|
|
notifyIf :: Bool -> String -> String -> IO ()
|
|
notifyIf True s _ = notify IconInfo s
|
|
notifyIf False _ s = notify IconError s
|
|
|
|
notify :: NotifyIcon -> String -> IO ()
|
|
notify icon body = void $ spawnProcess "notify-send" $ args ++ [body]
|
|
where
|
|
args = ["-i", show icon, summary]
|
|
summary = "ExpressVPN"
|