diff --git a/bin/xmobar.hs b/bin/xmobar.hs index d802c28..36c230d 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -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 diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs index 20b060e..5acd503 100644 --- a/lib/Xmobar/Plugins/VPN.hs +++ b/lib/Xmobar/Plugins/VPN.hs @@ -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"