147 lines
4.6 KiB
Haskell
147 lines
4.6 KiB
Haskell
--------------------------------------------------------------------------------
|
|
-- rofi-evpn - a prompt to dicsonnect/connect with express VPN
|
|
--
|
|
|
|
module Main (main) where
|
|
|
|
import RIO
|
|
import qualified RIO.Text as T
|
|
import Rofi.Command
|
|
import Rofi.IO
|
|
import UnliftIO.Environment
|
|
|
|
main :: IO ()
|
|
main = runSimpleApp $ getArgs >>= runPrompt
|
|
|
|
runPrompt :: [String] -> RIO SimpleApp ()
|
|
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
|
|
runRofi (RofiVPNConf $ fmap T.pack args) $
|
|
emptyMenu
|
|
{ groups =
|
|
[ untitledGroup $ toRofiActions $ maybeToList d
|
|
, untitledGroup $ toRofiActions cs
|
|
]
|
|
, prompt = Just "Select Action"
|
|
}
|
|
|
|
newtype RofiVPNConf = RofiVPNConf [T.Text]
|
|
|
|
instance HasRofiConf RofiVPNConf where
|
|
defArgs (RofiVPNConf as) = as
|
|
|
|
type VPNAction = RofiAction RofiVPNConf
|
|
|
|
type VPNServer = (T.Text, T.Text)
|
|
|
|
data VPNStatus = VPNStatus (Maybe T.Text) [VPNServer] deriving (Show)
|
|
|
|
getServers :: MonadIO m => m (Maybe VPNStatus)
|
|
getServers = do
|
|
running <- daemonIsRunning
|
|
if running
|
|
then Just <$> getStatus
|
|
else notifyEVPN IconError "ExpressVPN daemon not running" >> return Nothing
|
|
|
|
getStatus :: MonadIO m => m VPNStatus
|
|
getStatus = do
|
|
connected <- getConnectedServer
|
|
VPNStatus connected <$> getAvailableServers
|
|
|
|
getConnectedServer :: MonadIO m => m (Maybe T.Text)
|
|
getConnectedServer = (procStatus =<<) <$> readCmdSuccess eVPN ["status"] ""
|
|
where
|
|
procStatus = listToMaybe . mapMaybe procLine . T.lines
|
|
procLine l = case T.words l of
|
|
-- the output is green...
|
|
("\ESC[1;32;49mConnected" : "to" : server) -> Just $ T.unwords server
|
|
_ -> Nothing
|
|
|
|
getAvailableServers :: MonadIO m => m [VPNServer]
|
|
getAvailableServers = procOut =<< readCmdSuccess eVPN ["ls"] ""
|
|
where
|
|
procOut Nothing = do
|
|
notifyEVPN 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 . T.split (== '\t')) $
|
|
takeWhile (/= "") $
|
|
drop 1
|
|
-- super lame way of matching lines that start with "-----"
|
|
$
|
|
dropWhile (not . T.isPrefixOf "-----") $
|
|
T.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 :: MonadIO m => m Bool
|
|
daemonIsRunning = isJust <$> readCmdSuccess "pgrep" [eVPND] ""
|
|
|
|
getDisconnectAction :: T.Text -> VPNAction
|
|
getDisconnectAction server =
|
|
(T.append "Disconnect from " server, io $ void $ disconnect server)
|
|
|
|
getConnectAction :: Maybe T.Text -> 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 -> T.Text
|
|
formatServerLine (sid, sname) = T.concat [pad sid, " | ", sname]
|
|
where
|
|
pad s = T.append s $ T.replicate (10 - T.length s) " "
|
|
|
|
eVPN :: T.Text
|
|
eVPN = "expressvpn"
|
|
|
|
eVPND :: T.Text
|
|
eVPND = "expressvpnd"
|
|
|
|
connect :: MonadIO m => VPNServer -> m ()
|
|
connect (sid, sname) = do
|
|
res <- readCmdSuccess' eVPN ["connect", sid]
|
|
notifyIf
|
|
res
|
|
(T.append "connected to " sname)
|
|
(T.append "failed to connect to " sname)
|
|
|
|
disconnect :: MonadIO m => T.Text -> m Bool
|
|
disconnect server = do
|
|
res <- readCmdSuccess' eVPN ["disconnect"]
|
|
notifyIf
|
|
res
|
|
(T.append "disconnected from " server)
|
|
(T.append "failed to disconnect from " server)
|
|
return res
|
|
|
|
readCmdSuccess' :: MonadIO m => T.Text -> [T.Text] -> m Bool
|
|
readCmdSuccess' cmd args = isJust <$> readCmdSuccess cmd args ""
|
|
|
|
notifyIf :: MonadIO m => Bool -> T.Text -> T.Text -> m ()
|
|
notifyIf True s _ = notifyEVPN IconInfo s
|
|
notifyIf False _ s = notifyEVPN IconError s
|
|
|
|
notifyEVPN :: MonadIO m => NotifyIcon -> T.Text -> m ()
|
|
notifyEVPN icon = notify icon "ExpressVPN" . Just
|