FIX vpn not showing when no NM profiles exist
This commit is contained in:
parent
250d5c5eed
commit
0a4edb6bf2
|
@ -13,13 +13,10 @@ import Data.Internal.DBus
|
||||||
import Data.Internal.XIO
|
import Data.Internal.XIO
|
||||||
import Options.Applicative
|
import Options.Applicative
|
||||||
import RIO hiding (hFlush)
|
import RIO hiding (hFlush)
|
||||||
import qualified RIO.ByteString.Lazy as BL
|
|
||||||
import RIO.List
|
import RIO.List
|
||||||
import RIO.Process
|
|
||||||
import qualified RIO.Text as T
|
import qualified RIO.Text as T
|
||||||
import XMonad.Config.Prime (enumFrom)
|
import XMonad.Config.Prime (enumFrom)
|
||||||
import XMonad.Core hiding (config)
|
import XMonad.Core hiding (config)
|
||||||
import XMonad.Internal.Command.Desktop
|
|
||||||
import XMonad.Internal.Command.Power
|
import XMonad.Internal.Command.Power
|
||||||
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
|
@ -238,15 +235,9 @@ getBattery = iconIO_ "battery level indicator" xpfBattery root tree
|
||||||
fmap (Msg LevelError) <$> hasBattery
|
fmap (Msg LevelError) <$> hasBattery
|
||||||
|
|
||||||
getVPN :: Maybe SysClient -> BarFeature
|
getVPN :: Maybe SysClient -> BarFeature
|
||||||
getVPN cl = iconDBus_ "VPN status indicator" xpfVPN root $ toAnd_ vpnDep test
|
getVPN cl = iconDBus_ "VPN status indicator" xpfVPN root (Only_ vpnDep)
|
||||||
where
|
where
|
||||||
root useIcon tree = DBusRoot_ (const $ vpnCmd useIcon) tree cl
|
root useIcon tree = DBusRoot_ (const $ vpnCmd useIcon) tree cl
|
||||||
test =
|
|
||||||
DBusIO $
|
|
||||||
IOTest_
|
|
||||||
"Use nmcli to test if VPN is present"
|
|
||||||
networkManagerPkgs
|
|
||||||
vpnPresent
|
|
||||||
|
|
||||||
getBt :: Maybe SysClient -> BarFeature
|
getBt :: Maybe SysClient -> BarFeature
|
||||||
getBt = xmobarDBus "bluetooth status indicator" xpfBluetooth btDep btCmd
|
getBt = xmobarDBus "bluetooth status indicator" xpfBluetooth btDep btCmd
|
||||||
|
@ -423,7 +414,7 @@ vpnCmd :: Fontifier -> CmdSpec
|
||||||
vpnCmd fontify =
|
vpnCmd fontify =
|
||||||
CmdSpec
|
CmdSpec
|
||||||
{ csAlias = vpnAlias
|
{ csAlias = vpnAlias
|
||||||
, csRunnable = Run $ VPN (T.append (fontify IconMedium "\xf023" "VPN") " ", colors)
|
, csRunnable = Run $ VPN (fontify IconMedium "\xf023" "VPN", colors)
|
||||||
}
|
}
|
||||||
|
|
||||||
btCmd :: Fontifier -> CmdSpec
|
btCmd :: Fontifier -> CmdSpec
|
||||||
|
@ -521,29 +512,6 @@ dateCmd =
|
||||||
, csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
|
, csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
|
||||||
}
|
}
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- low-level testing functions
|
|
||||||
|
|
||||||
vpnPresent :: XIO (Maybe Msg)
|
|
||||||
vpnPresent = do
|
|
||||||
res <- proc "nmcli" args readProcess
|
|
||||||
return $ case res of
|
|
||||||
(ExitSuccess, out, _)
|
|
||||||
| "vpn" `elem` BL.split 10 out -> Nothing
|
|
||||||
| otherwise -> Just $ Msg LevelError "vpn not found"
|
|
||||||
(ExitFailure c, _, err) ->
|
|
||||||
Just $
|
|
||||||
Msg LevelError $
|
|
||||||
T.concat
|
|
||||||
[ "vpn search exited with code "
|
|
||||||
, T.pack $ show c
|
|
||||||
, ": "
|
|
||||||
, T.decodeUtf8With T.lenientDecode $
|
|
||||||
BL.toStrict err
|
|
||||||
]
|
|
||||||
where
|
|
||||||
args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- text font
|
-- text font
|
||||||
--
|
--
|
||||||
|
|
|
@ -39,7 +39,7 @@ instance Exec VPN where
|
||||||
where
|
where
|
||||||
formatter names = return $ case names of
|
formatter names = return $ case names of
|
||||||
[] -> colorText colors False text
|
[] -> colorText colors False text
|
||||||
xs -> T.append (colorText colors True text) $ T.intercalate "|" xs
|
xs -> T.unwords [T.intercalate "|" xs, colorText colors True text]
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- VPN State
|
-- VPN State
|
||||||
|
@ -74,11 +74,6 @@ initState = do
|
||||||
readState :: VIO [T.Text]
|
readState :: VIO [T.Text]
|
||||||
readState = M.elems <$> (readMVar =<< asks vState)
|
readState = M.elems <$> (readMVar =<< asks vState)
|
||||||
|
|
||||||
-- updateState :: (ObjectPath -> VPNState -> VPNState) -> ObjectPath -> VIO ()
|
|
||||||
-- updateState f op = do
|
|
||||||
-- s <- asks vState
|
|
||||||
-- modifyMVar_ s $ return . f op
|
|
||||||
|
|
||||||
insertState :: ObjectPath -> T.Text -> VIO ()
|
insertState :: ObjectPath -> T.Text -> VIO ()
|
||||||
insertState op name = do
|
insertState op name = do
|
||||||
s <- asks vState
|
s <- asks vState
|
||||||
|
@ -151,18 +146,6 @@ removedCallback [device, _] =
|
||||||
beforeDisplay $ forM_ (fromVariant device) deleteState
|
beforeDisplay $ forM_ (fromVariant device) deleteState
|
||||||
removedCallback _ = return ()
|
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
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- DBus Interface
|
-- DBus Interface
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue