ENH show VPN interface names

This commit is contained in:
Nathan Dwarshuis 2023-09-29 23:44:08 -04:00
parent 770f1dc1dd
commit 250d5c5eed
2 changed files with 49 additions and 32 deletions

View File

@ -423,7 +423,7 @@ vpnCmd :: Fontifier -> CmdSpec
vpnCmd fontify =
CmdSpec
{ csAlias = vpnAlias
, csRunnable = Run $ VPN (fontify IconMedium "\xf023" "VPN", colors)
, csRunnable = Run $ VPN (T.append (fontify IconMedium "\xf023" "VPN") " ", colors)
}
btCmd :: Fontifier -> CmdSpec

View File

@ -17,7 +17,6 @@ import Data.Internal.DBus
import Data.Internal.XIO
import RIO
import qualified RIO.Map as M
import qualified RIO.Set as S
import qualified RIO.Text as T
import XMonad.Internal.Command.Desktop
import XMonad.Internal.DBus.Common
@ -30,7 +29,7 @@ instance Exec VPN where
alias (VPN _) = T.unpack vpnAlias
start (VPN (text, colors)) cb =
withDBusClientConnection cb (Just "vpn.log") $ \c -> do
let dpy = displayMaybe cb iconFormatter . Just =<< readState
let dpy = displayMaybe cb formatter . Just =<< readState
s <- newEmptyMVar
mapRIO (VEnv c s dpy) $ do
initState
@ -38,7 +37,9 @@ instance Exec VPN where
vpnRemovedListener removedCallback
dpy
where
iconFormatter b = return $ colorText colors b text
formatter names = return $ case names of
[] -> colorText colors False text
xs -> T.append (colorText colors True text) $ T.intercalate "|" xs
--------------------------------------------------------------------------------
-- VPN State
@ -62,7 +63,7 @@ instance HasClient VEnv where
type VIO = RIO (VEnv SysClient)
type VPNState = S.Set ObjectPath
type VPNState = M.Map ObjectPath T.Text
initState :: VIO ()
initState = do
@ -70,13 +71,23 @@ initState = do
s <- asks vState
putMVar s $ findTunnels ot
readState :: VIO Bool
readState = fmap (not . null) . readMVar =<< asks vState
readState :: VIO [T.Text]
readState = M.elems <$> (readMVar =<< asks vState)
updateState :: (ObjectPath -> VPNState -> VPNState) -> ObjectPath -> VIO ()
updateState f op = do
-- updateState :: (ObjectPath -> VPNState -> VPNState) -> ObjectPath -> VIO ()
-- updateState f op = do
-- s <- asks vState
-- modifyMVar_ s $ return . f op
insertState :: ObjectPath -> T.Text -> VIO ()
insertState op name = do
s <- asks vState
modifyMVar_ s $ return . f op
modifyMVar_ s $ return . M.insert op name
deleteState :: ObjectPath -> VIO ()
deleteState op = do
s <- asks vState
modifyMVar_ s $ return . M.delete op
beforeDisplay :: VIO () -> VIO ()
beforeDisplay f = f >> join (asks vDisplay)
@ -95,7 +106,15 @@ getVPNObjectTree
getVPNObjectTree = callGetManagedObjects vpnBus vpnPath
findTunnels :: ObjectTree -> VPNState
findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
findTunnels = M.mapMaybe lookupVPNInterface
-- | For the interface map underneath a given object path, try to lookup a
-- VPN interface, then lookup the ip link name from the parent interface
lookupVPNInterface :: M.Map T.Text (M.Map T.Text Variant) -> Maybe T.Text
lookupVPNInterface m
| isJust $ M.lookup vpnDeviceTun m =
fromVariant =<< M.lookup "Interface" =<< M.lookup vpnDeviceParent m
| otherwise = Nothing
vpnAddedListener
:: ( SafeClient c
@ -122,32 +141,27 @@ vpnRemovedListener cb = void $ addInterfaceRemovedListener vpnBus vpnPath cb
addedCallback :: SignalCallback VIO
addedCallback [device, added] =
beforeDisplay $
updateDevice S.insert device $
M.keys $
fromMaybe M.empty added'
where
added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
forM_ (fromVariant device) $ \d ->
forM_ (lookupVPNInterface =<< fromVariant added) $
insertState d
addedCallback _ = return ()
removedCallback :: SignalCallback VIO
removedCallback [device, interfaces] =
beforeDisplay $
updateDevice S.delete device $
fromMaybe [] $
fromVariant interfaces
removedCallback [device, _] =
beforeDisplay $ forM_ (fromVariant device) deleteState
removedCallback _ = return ()
updateDevice
:: (ObjectPath -> VPNState -> VPNState)
-> Variant
-> [T.Text]
-> VIO ()
updateDevice f device interfaces =
when (vpnDeviceTun `elem` interfaces) $
forM_ d $
updateState f
where
d = fromVariant device :: Maybe ObjectPath
-- updateDevice
-- :: (ObjectPath -> VPNState -> VPNState)
-- -> Variant
-- -> [T.Text]
-- -> VIO ()
-- updateDevice f device interfaces =
-- when (vpnDeviceTun `elem` interfaces) $
-- forM_ d $
-- updateState f
-- where
-- d = fromVariant device :: Maybe ObjectPath
--------------------------------------------------------------------------------
-- DBus Interface
@ -161,6 +175,9 @@ vpnPath = objectPath_ "/org/freedesktop"
vpnDeviceTun :: T.Text
vpnDeviceTun = "org.freedesktop.NetworkManager.Device.Tun"
vpnDeviceParent :: T.Text
vpnDeviceParent = "org.freedesktop.NetworkManager.Device"
vpnAlias :: T.Text
vpnAlias = "vpn"