ADD rofi menu for expressVPN
This commit is contained in:
parent
c4a9c6462d
commit
ded4f4a0b4
|
@ -0,0 +1,150 @@
|
|||
--------------------------------------------------------------------------------
|
||||
-- | rofi-evpn - a prompt to dicsonnect/connect with express VPN
|
||||
--
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import Control.Monad
|
||||
|
||||
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 s = case words <$> lines s 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 header that has three lines, followed by the
|
||||
-- stuff we care about, which is followed by a blank line (after which there
|
||||
-- is other stuff that doesn't matter based on the way I'm parsing below)
|
||||
procOut (Just ls) = return
|
||||
$ mapMaybe (matchLine . splitOn "\t")
|
||||
$ drop 3
|
||||
$ takeWhile (/= "")
|
||||
$ 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"
|
10
package.yaml
10
package.yaml
|
@ -101,6 +101,16 @@ executables:
|
|||
dependencies:
|
||||
- rofi-extras
|
||||
|
||||
rofi-evpn:
|
||||
main: rofi-evpn.hs
|
||||
source-dirs: app
|
||||
ghc-options:
|
||||
- -Wall
|
||||
- -Werror
|
||||
- -threaded
|
||||
dependencies:
|
||||
- rofi-extras
|
||||
|
||||
current-output:
|
||||
main: current-output.hs
|
||||
source-dirs: app
|
||||
|
|
Loading…
Reference in New Issue