module Monky.Wifi
( getCurrentWifi
, getCurrentWifiStats
, getInterface
, guessInterface
, gotReadable
, getSSIDSocket
, Interface
, SSIDSocket
, getWifiFd
, prepareEvents
, getExtendedWifi
, Signal(..)
, WifiStats(..)
, WifiConn(..)
)
where
import Data.Bits ((.&.))
import Data.Word (Word8, Word32)
import Data.Maybe (listToMaybe, fromMaybe)
import System.Posix.Types (Fd)
import System.Linux.Netlink (Packet(..), getAttributes, Attributes)
import System.Linux.Netlink.GeNetlink (GenlHeader(..), GenlData(..))
import System.Linux.Netlink.GeNetlink.NL80211
import System.Linux.Netlink.GeNetlink.NL80211.Constants
import qualified Data.Map as M
import qualified Data.ByteString as BS
import Data.ByteString (ByteString)
import Data.Serialize (Serialize, decode)
import Data.Serialize.Get (runGet, getWord32host)
import Data.Serialize.Put (runPut, putWord32host)
#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<$>), pure)
#endif
type Interface = Word32
data SSIDSocket = SSIDSocket NL80211Socket NL80211Socket
data WifiConn
= WifiNone
| WifiDisconnect
| WifiConnect WifiStats
data Signal
= SigMBM Word32
| SigUNSPEC Word8
data WifiStats = WifiStats
{ wifiChannel :: Word8
, wifiRates :: [Word32]
, wifiName :: String
, wifiFreq :: Word32
, wifiSig :: Signal
, wifiBSSID :: ByteString
}
uDecode :: Serialize a => Maybe ByteString -> Maybe a
uDecode = fmap (\bs -> let (Right x) = decode bs in x)
uGetWord32 :: Maybe ByteString -> Maybe Word32
uGetWord32 = fmap (\bs -> let (Right x) = runGet getWord32host bs in x)
getBssAttrs :: Attributes -> Maybe Attributes
getBssAttrs attr = do
bs <- M.lookup eNL80211_ATTR_BSS attr
case runGet getAttributes bs of
(Left _) -> Nothing
(Right x) -> return x
getSignal :: Maybe Word32 -> Maybe Word8 -> Signal
getSignal Nothing (Just unspec) = SigUNSPEC unspec
getSignal (Just mbm) Nothing = SigMBM mbm
getSignal x y = error ("Wifi signal is weird, should be either, got: " ++ show x ++ " and " ++ show y)
attrToStat :: NL80211Packet -> Maybe WifiStats
attrToStat pack = do
pattrs <- getBssAttrs $ packetAttributes pack
attrs <- getWifiAttributes pack
name <- fmap show . M.lookup eWLAN_EID_SSID $ attrs
channel <- uDecode . M.lookup eWLAN_EID_DS_PARAMS $ attrs
rate <- M.lookup eWLAN_EID_SUPP_RATES attrs
freq <- uDecode . M.lookup eNL80211_BSS_FREQUENCY $ pattrs
ssid <- M.lookup eNL80211_BSS_BSSID pattrs
let mbm = uGetWord32 . M.lookup eNL80211_BSS_SIGNAL_MBM $ pattrs
let sig = uDecode . M.lookup eNL80211_BSS_SIGNAL_UNSPEC $ pattrs
let bs = M.lookup eWLAN_EID_EXT_SUPP_RATES attrs
let ratL = rate `BS.append` fromMaybe BS.empty bs
let rates = map (\y -> fromIntegral (y .&. 0x7F) * (500000 :: Word32)) . BS.unpack $ ratL
return $ WifiStats channel rates name freq (getSignal mbm sig) ssid
getCurrentWifiStats :: SSIDSocket -> Interface -> IO (Maybe WifiStats)
getCurrentWifiStats (SSIDSocket _ s) i = do
wifis <- getConnectedWifi s i
return $ attrToStat =<< listToMaybe wifis
getCurrentWifi :: SSIDSocket -> Interface -> IO (Maybe String)
getCurrentWifi s i = fmap wifiName <$> getCurrentWifiStats s i
getInterface :: SSIDSocket -> String -> IO (Maybe Interface)
getInterface (SSIDSocket s _) n = do
interfaces <- getInterfaceList s
return $ snd <$> listToMaybe (filter ((==) n . fst) interfaces)
guessInterface :: SSIDSocket -> IO (Maybe Interface)
guessInterface (SSIDSocket s _) = do
interfaces <- getInterfaceList s
pure $ snd <$> listToMaybe interfaces
getWifiFd :: SSIDSocket -> Fd
getWifiFd (SSIDSocket s _) = getFd s
gotReadable :: SSIDSocket -> Interface -> IO WifiConn
gotReadable b@(SSIDSocket s _) i = do
ps <- getPacket s
if null ps
then error "Failed to get a package in gotReadable, this should not be possible"
else do
let packet = head ps
let cmd = genlCmd . genlDataHeader . packetCustom $ packet
if cmd == eNL80211_CMD_CONNECT
then do
wifi <- getCurrentWifiStats b i
return $ case wifi of
Nothing -> WifiDisconnect
Just x -> WifiConnect x
else if cmd == eNL80211_CMD_DISCONNECT
then let bs = M.lookup eNL80211_ATTR_IFINDEX (packetAttributes packet) in
if maybe False (== i) . uGetWord32 $ bs
then return WifiDisconnect
else return WifiNone
else return WifiNone
getStation :: NL80211Socket -> Word32 -> ByteString -> IO [NL80211Packet]
getStation s i m = query s eNL80211_CMD_GET_STATION False attrs
where attrs = M.fromList [(eNL80211_ATTR_IFINDEX, runPut . putWord32host $ i), (eNL80211_ATTR_MAC, m)]
getExtendedWifi :: SSIDSocket -> Interface -> WifiStats -> IO (Maybe NL80211Packet)
getExtendedWifi (SSIDSocket _ s) i stats =
listToMaybe <$> getStation s i (wifiBSSID stats)
prepareEvents :: SSIDSocket -> IO ()
prepareEvents (SSIDSocket s _) = joinMulticastByName s "mlme"
getSSIDSocket :: IO SSIDSocket
getSSIDSocket = do
s <- makeNL80211Socket
e <- makeNL80211Socket
return $ SSIDSocket s e