{-# LANGUAGE CPP #-}
#ifdef USE_NL80211
{-# LANGUAGE TypeApplications #-}
#endif
module Xmobar.Plugins.Monitors.Wireless (wirelessConfig, runWireless) where
import System.Console.GetOpt
import Xmobar.Plugins.Monitors.Common
#ifdef IWLIB
import Network.IWlib
#elif defined USE_NL80211
import Control.Exception (bracket)
import qualified Data.Map as M
import GHC.Int (Int8)
import Data.Maybe (listToMaybe, fromMaybe)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import Data.ByteString.Char8 (unpack)
import Data.Serialize.Put (runPut, putWord32host, putByteString)
import Data.Serialize.Get (runGet)
import System.Linux.Netlink hiding (query)
import System.Linux.Netlink.GeNetlink.NL80211
import System.Linux.Netlink.GeNetlink.NL80211.StaInfo
import System.Linux.Netlink.GeNetlink.NL80211.Constants
import System.Posix.IO (closeFd)
data IwData = IwData { IwData -> String
wiEssid :: String, IwData -> Maybe Int
wiSignal :: Maybe Int, IwData -> Int
wiQuality :: Int }
getWirelessInfo :: String -> IO IwData
getWirelessInfo :: String -> IO IwData
getWirelessInfo String
ifname =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO NL80211Socket
makeNL80211Socket (Fd -> IO ()
closeFd forall b c a. (b -> c) -> (a -> b) -> a -> c
. NL80211Socket -> Fd
getFd) (\NL80211Socket
s -> do
[(String, Word32)]
iflist <- NL80211Socket -> IO [(String, Word32)]
getInterfaceList NL80211Socket
s
Maybe IwData
iwdata <- forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
Word32
ifidx <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(String
n, Word32
i) Maybe Word32
z ->
if String
ifname forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
|| String
ifname forall a. Eq a => a -> a -> Bool
== String
n then forall a. a -> Maybe a
Just Word32
i else Maybe Word32
z)
forall a. Maybe a
Nothing
[(String, Word32)]
iflist
NL80211Packet
scanp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (NL80211Socket -> Word32 -> IO [NL80211Packet]
getConnectedWifi NL80211Socket
s Word32
ifidx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
ByteString
bssid <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a. Num a => a
eNL80211_ATTR_BSS (forall a. Packet a -> Attributes
packetAttributes NL80211Packet
scanp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall {a} {a}. Either a a -> Maybe a
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a. Num a => a
eNL80211_BSS_BSSID
NL80211Packet
stap <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (NL80211Socket -> Word8 -> Bool -> Attributes -> IO [NL80211Packet]
query NL80211Socket
s forall a. Num a => a
eNL80211_CMD_GET_STATION Bool
True forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[(forall a. Num a => a
eNL80211_ATTR_IFINDEX, Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Putter Word32
putWord32host Word32
ifidx),
(forall a. Num a => a
eNL80211_ATTR_MAC, Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Putter ByteString
putByteString ByteString
bssid)]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
let ssid :: String
ssid = forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ NL80211Packet -> Maybe Attributes
getWifiAttributes NL80211Packet
scanp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a. Num a => a
eWLAN_EID_SSID forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpack
signal :: Maybe Int
signal = forall a. Packet a -> Maybe StaInfo
staInfoFromPacket NL80211Packet
stap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StaInfo -> Maybe Word8
staSignalMBM forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
qlty :: Int
qlty = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1) (forall a b. (RealFrac a, Integral b) => a -> b
round @Float forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ Float
0.7) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Float
110) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {a}. Ord a => a -> a -> a -> a
clamp (-Float
110) (-Float
40) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Maybe Int
signal
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Maybe Int -> Int -> IwData
IwData String
ssid Maybe Int
signal Int
qlty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe Int -> Int -> IwData
IwData String
"" forall a. Maybe a
Nothing (-Int
1)) Maybe IwData
iwdata)
where
rightToMaybe :: Either a a -> Maybe a
rightToMaybe = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
clamp :: a -> a -> a -> a
clamp a
lb a
up a
v
| a
v forall a. Ord a => a -> a -> Bool
< a
lb = a
lb
| a
v forall a. Ord a => a -> a -> Bool
> a
up = a
up
| Bool
otherwise = a
v
#endif
newtype WirelessOpts = WirelessOpts
{ WirelessOpts -> Maybe IconPattern
qualityIconPattern :: Maybe IconPattern
}
defaultOpts :: WirelessOpts
defaultOpts :: WirelessOpts
defaultOpts = WirelessOpts
{ qualityIconPattern :: Maybe IconPattern
qualityIconPattern = forall a. Maybe a
Nothing
}
options :: [OptDescr (WirelessOpts -> WirelessOpts)]
options :: [OptDescr (WirelessOpts -> WirelessOpts)]
options =
[ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"quality-icon-pattern"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
d WirelessOpts
opts ->
WirelessOpts
opts { qualityIconPattern :: Maybe IconPattern
qualityIconPattern = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> IconPattern
parseIconPattern String
d }) String
"") String
""
]
wirelessConfig :: IO MConfig
wirelessConfig :: IO MConfig
wirelessConfig =
String -> [String] -> IO MConfig
mkMConfig String
"<ssid> <quality>"
[String
"ssid", String
"essid", String
"signal", String
"quality", String
"qualitybar", String
"qualityvbar", String
"qualityipat"]
runWireless :: String -> [String] -> Monitor String
runWireless :: String -> [String] -> Monitor String
runWireless String
iface [String]
args = do
WirelessOpts
opts <- forall a. IO a -> Monitor a
io forall a b. (a -> b) -> a -> b
$ forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (WirelessOpts -> WirelessOpts)]
options WirelessOpts
defaultOpts [String]
args
#ifdef IWLIB
iface' <- if "" == iface then io findInterface else return iface
#else
let iface' :: String
iface' = String
iface
#endif
IwData
wi <- forall a. IO a -> Monitor a
io forall a b. (a -> b) -> a -> b
$ String -> IO IwData
getWirelessInfo String
iface'
String
na <- forall a. Selector a -> Monitor a
getConfigValue MConfig -> IORef String
naString
let essid :: String
essid = IwData -> String
wiEssid IwData
wi
qlty :: Float
qlty = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ IwData -> Int
wiQuality IwData
wi
e :: String
e = if String
essid forall a. Eq a => a -> a -> Bool
== String
"" then String
na else String
essid
String
ep <- String -> Monitor String
showWithPadding String
e
#ifdef USE_NL80211
let s :: Maybe Int
s = IwData -> Maybe Int
wiSignal IwData
wi
#else
let s = if qlty >= 0 then Just (qlty * 0.7 - 110) else Nothing
#endif
String
sp <- String -> Monitor String
showWithPadding forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Show a => a -> String
show Maybe Int
s
String
q <- if Float
qlty forall a. Ord a => a -> a -> Bool
>= Float
0
then Float -> Monitor String
showPercentWithColors (Float
qlty forall a. Fractional a => a -> a -> a
/ Float
100)
else String -> Monitor String
showWithPadding String
""
String
qb <- Float -> Float -> Monitor String
showPercentBar Float
qlty (Float
qlty forall a. Fractional a => a -> a -> a
/ Float
100)
String
qvb <- Float -> Float -> Monitor String
showVerticalBar Float
qlty (Float
qlty forall a. Fractional a => a -> a -> a
/ Float
100)
String
qipat <- Maybe IconPattern -> Float -> Monitor String
showIconPattern (WirelessOpts -> Maybe IconPattern
qualityIconPattern WirelessOpts
opts) (Float
qlty forall a. Fractional a => a -> a -> a
/ Float
100)
[String] -> Monitor String
parseTemplate [String
ep, String
ep, String
sp, String
q, String
qb, String
qvb, String
qipat]
#ifdef IWLIB
findInterface :: IO String
findInterface = do
c <- readFile "/proc/net/wireless"
let nds = lines c
return $ if length nds > 2 then takeWhile (/= 'c') (nds!!2) else []
#endif