{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module System.Linux.Netlink.GeNetlink.NL80211
( NL80211Socket
, NL80211Packet
, makeNL80211Socket
, joinMulticastByName
, queryOne
, query
, getInterfaceList
, getScanResults
, getConnectedWifi
, getWifiAttributes
, getPacket
, getFd
, getMulticastGroups
)
where
#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<$>))
#endif
import Data.Bits ((.|.))
import Data.ByteString.Char8 (unpack)
import Data.List (intercalate)
import Data.Maybe (mapMaybe)
import Data.Serialize.Get (runGet, getWord32host)
import Data.Serialize.Put (runPut, putWord32host)
import Data.Word (Word32, Word16, Word8)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (length)
import qualified Data.Map as M (empty, lookup, fromList, member, toList)
import System.Posix.Types (Fd)
import System.Linux.Netlink.Helpers (indent)
import System.Linux.Netlink.Constants
import System.Linux.Netlink.GeNetlink
import System.Linux.Netlink.GeNetlink.Control hiding (getMulticastGroups)
import qualified System.Linux.Netlink.GeNetlink.Control as C
import System.Linux.Netlink.GeNetlink.NL80211.Constants
import System.Linux.Netlink.GeNetlink.NL80211.StaInfo
import System.Linux.Netlink.GeNetlink.NL80211.WifiEI
import System.Linux.Netlink hiding (makeSocket, queryOne, query, recvOne, getPacket)
import qualified System.Linux.Netlink as I (queryOne, query, recvOne)
data NL80211Socket = NLS NetlinkSocket Word16
data NoData80211 = NoData80211 deriving (NoData80211 -> NoData80211 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoData80211 -> NoData80211 -> Bool
$c/= :: NoData80211 -> NoData80211 -> Bool
== :: NoData80211 -> NoData80211 -> Bool
$c== :: NoData80211 -> NoData80211 -> Bool
Eq, Int -> NoData80211 -> ShowS
[NoData80211] -> ShowS
NoData80211 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoData80211] -> ShowS
$cshowList :: [NoData80211] -> ShowS
show :: NoData80211 -> String
$cshow :: NoData80211 -> String
showsPrec :: Int -> NoData80211 -> ShowS
$cshowsPrec :: Int -> NoData80211 -> ShowS
Show)
instance Convertable NoData80211 where
getPut :: NoData80211 -> Put
getPut NoData80211
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
getGet :: MessageType -> Get NoData80211
getGet MessageType
_ = forall (m :: * -> *) a. Monad m => a -> m a
return NoData80211
NoData80211
type NL80211Packet = GenlPacket NoData80211
instance Show NL80211Packet where
showList :: [NL80211Packet] -> ShowS
showList [NL80211Packet]
xs = ((forall a. [a] -> [[a]] -> [a]
intercalate String
"===\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$[NL80211Packet]
xs) forall a. [a] -> [a] -> [a]
++)
show :: NL80211Packet -> String
show (Packet Header
_ GenlData NoData80211
cus Attributes
attrs) =
String
"NL80211Packet: " forall a. [a] -> [a] -> [a]
++ GenlData NoData80211 -> String
showNL80211Command GenlData NoData80211
cus forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
String
"Attrs: \n" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, ByteString) -> String
showNL80211Attr (forall k a. Map k a -> [(k, a)]
M.toList Attributes
attrs) forall a. [a] -> [a] -> [a]
++ String
"\n"
show NL80211Packet
p = forall a. Show a => Packet a -> String
showPacket NL80211Packet
p
showNL80211Command :: (GenlData NoData80211) -> String
showNL80211Command :: GenlData NoData80211 -> String
showNL80211Command (GenlData (GenlHeader Word8
cmd Word8
_) NoData80211
_ ) =
forall a. (Num a, Show a, Eq a) => a -> String
showNL80211Commands Word8
cmd
showNL80211Attr :: (Int, ByteString) -> String
showNL80211Attr :: (Int, ByteString) -> String
showNL80211Attr (Int
i, ByteString
v)
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eNL80211_ATTR_STA_INFO = ByteString -> String
showStaInfo ByteString
v
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eNL80211_ATTR_RESP_IE = ByteString -> String
showWifiEid ByteString
v
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eNL80211_ATTR_BSS = ByteString -> String
showAttrBss ByteString
v
| Bool
otherwise = (Int -> String) -> (Int, ByteString) -> String
showAttr forall a. (Num a, Show a, Eq a) => a -> String
showNL80211Attrs (Int
i, ByteString
v)
showStaInfo :: ByteString -> String
showStaInfo :: ByteString -> String
showStaInfo ByteString
bs = let attrs :: Attributes
attrs = forall a b. Show a => Either a b -> b
getRight forall a b. (a -> b) -> a -> b
$ forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes ByteString
bs in
String
"NL80211_ATTR_STA_INFO: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bs) forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
(ShowS
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StaInfo
staInfoFromAttributes forall a b. (a -> b) -> a -> b
$ Attributes
attrs)
showAttrBss :: ByteString -> String
showAttrBss :: ByteString -> String
showAttrBss ByteString
bs = let attrs :: Attributes
attrs = forall a b. Show a => Either a b -> b
getRight forall a b. (a -> b) -> a -> b
$ forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes ByteString
bs in
String
"NL80211_ATTR_BSS: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bs) forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
(ShowS
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, ByteString) -> String
showBssAttr forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Attributes
attrs)
showBssAttr :: (Int, ByteString) -> String
showBssAttr :: (Int, ByteString) -> String
showBssAttr (Int
i, ByteString
v)
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eNL80211_BSS_INFORMATION_ELEMENTS = String
"NL80211_BSS_INFORMATION_ELEMENTS " forall a. [a] -> [a] -> [a]
++ ByteString -> String
showWifiEid ByteString
v
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eNL80211_BSS_BEACON_IES = String
"NL80211_BSS_BEACON_IES " forall a. [a] -> [a] -> [a]
++ ByteString -> String
showWifiEid ByteString
v
| Bool
otherwise = (Int -> String) -> (Int, ByteString) -> String
showAttr forall a. (Num a, Show a, Eq a) => a -> String
showNL80211Bss (Int
i, ByteString
v)
getFd :: NL80211Socket -> Fd
getFd :: NL80211Socket -> Fd
getFd (NLS NetlinkSocket
s Word16
_) = NetlinkSocket -> Fd
getNetlinkFd NetlinkSocket
s
getRight :: Show a => Either a b -> b
getRight :: forall a b. Show a => Either a b -> b
getRight (Right b
x) = b
x
getRight (Left a
err) = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$forall a. Show a => a -> String
show a
err
makeNL80211Socket :: IO NL80211Socket
makeNL80211Socket :: IO NL80211Socket
makeNL80211Socket = do
NetlinkSocket
sock <- IO NetlinkSocket
makeSocket
Word16
fid <- NetlinkSocket -> String -> IO Word16
getFamilyId NetlinkSocket
sock String
"nl80211"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$NetlinkSocket -> Word16 -> NL80211Socket
NLS NetlinkSocket
sock Word16
fid
joinMulticastByName :: NL80211Socket -> String -> IO ()
joinMulticastByName :: NL80211Socket -> String -> IO ()
joinMulticastByName (NLS NetlinkSocket
sock Word16
_) String
name = do
(Word16
_, [CtrlAttrMcastGroup]
m) <- NetlinkSocket -> String -> IO (Word16, [CtrlAttrMcastGroup])
getFamilyWithMulticasts NetlinkSocket
sock String
"nl80211"
let gid :: Maybe Word32
gid = String -> [CtrlAttrMcastGroup] -> Maybe Word32
getMulticast String
name [CtrlAttrMcastGroup]
m
case Maybe Word32
gid of
Maybe Word32
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$String
"Could not find \"" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"\" multicast group"
Just Word32
x -> NetlinkSocket -> Word32 -> IO ()
joinMulticastGroup NetlinkSocket
sock Word32
x
getMulticastGroups :: NL80211Socket -> IO [String]
getMulticastGroups :: NL80211Socket -> IO [String]
getMulticastGroups (NLS NetlinkSocket
sock Word16
fid) =
forall a b. (a -> b) -> [a] -> [b]
map CtrlAttrMcastGroup -> String
grpName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetlinkSocket -> Word16 -> IO [CtrlAttrMcastGroup]
C.getMulticastGroups NetlinkSocket
sock Word16
fid
getRequestPacket :: Word16 -> Word8 -> Bool -> Attributes -> NL80211Packet
getRequestPacket :: Word16 -> Word8 -> Bool -> Attributes -> NL80211Packet
getRequestPacket Word16
fid Word8
cmd Bool
dump Attributes
attrs =
let header :: Header
header = MessageType -> Word16 -> Word32 -> Word32 -> Header
Header (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
fid) Word16
flags Word32
0 Word32
0
geheader :: GenlHeader
geheader = Word8 -> Word8 -> GenlHeader
GenlHeader Word8
cmd Word8
0 in
forall a. Header -> a -> Attributes -> Packet a
Packet Header
header (forall a. GenlHeader -> a -> GenlData a
GenlData GenlHeader
geheader NoData80211
NoData80211) Attributes
attrs
where flags :: Word16
flags = if Bool
dump then forall a. (Num a, Bits a) => a
fNLM_F_REQUEST forall a. Bits a => a -> a -> a
.|. forall a. (Num a, Bits a) => a
fNLM_F_MATCH forall a. Bits a => a -> a -> a
.|. forall a. (Num a, Bits a) => a
fNLM_F_ROOT else forall a. (Num a, Bits a) => a
fNLM_F_REQUEST
queryOne :: NL80211Socket -> Word8 -> Bool -> Attributes -> IO NL80211Packet
queryOne :: NL80211Socket -> Word8 -> Bool -> Attributes -> IO NL80211Packet
queryOne (NLS NetlinkSocket
sock Word16
fid) Word8
cmd Bool
dump Attributes
attrs = forall a.
(Convertable a, Eq a, Show a) =>
NetlinkSocket -> Packet a -> IO (Packet a)
I.queryOne NetlinkSocket
sock NL80211Packet
packet
where packet :: NL80211Packet
packet = Word16 -> Word8 -> Bool -> Attributes -> NL80211Packet
getRequestPacket Word16
fid Word8
cmd Bool
dump Attributes
attrs
query :: NL80211Socket -> Word8 -> Bool -> Attributes -> IO [NL80211Packet]
query :: NL80211Socket -> Word8 -> Bool -> Attributes -> IO [NL80211Packet]
query (NLS NetlinkSocket
sock Word16
fid) Word8
cmd Bool
dump Attributes
attrs = forall a.
(Convertable a, Eq a, Show a) =>
NetlinkSocket -> Packet a -> IO [Packet a]
I.query NetlinkSocket
sock NL80211Packet
packet
where packet :: NL80211Packet
packet = Word16 -> Word8 -> Bool -> Attributes -> NL80211Packet
getRequestPacket Word16
fid Word8
cmd Bool
dump Attributes
attrs
parseInterface :: (ByteString, ByteString) -> (String, Word32)
parseInterface :: (ByteString, ByteString) -> (String, Word32)
parseInterface (ByteString
name, ByteString
ifindex) =
(forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ByteString -> String
unpack ByteString
name, forall a b. Show a => Either a b -> b
getRight forall a b. (a -> b) -> a -> b
$forall a. Get a -> ByteString -> Either String a
runGet Get Word32
getWord32host ByteString
ifindex)
getInterfaceList :: NL80211Socket -> IO [(String, Word32)]
getInterfaceList :: NL80211Socket -> IO [(String, Word32)]
getInterfaceList NL80211Socket
sock = do
[NL80211Packet]
interfaces <- NL80211Socket -> Word8 -> Bool -> Attributes -> IO [NL80211Packet]
query NL80211Socket
sock forall a. Num a => a
eNL80211_CMD_GET_INTERFACE Bool
True forall k a. Map k a
M.empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, ByteString) -> (String, Word32)
parseInterface forall b c a. (b -> c) -> (a -> b) -> a -> c
. NL80211Packet -> Maybe (ByteString, ByteString)
toTuple) [NL80211Packet]
interfaces
where toTuple :: NL80211Packet -> Maybe (ByteString, ByteString)
toTuple :: NL80211Packet -> Maybe (ByteString, ByteString)
toTuple (Packet Header
_ GenlData NoData80211
_ Attributes
attrs) = do
ByteString
name <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a. Num a => a
eNL80211_ATTR_IFNAME Attributes
attrs
ByteString
findex <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a. Num a => a
eNL80211_ATTR_IFINDEX Attributes
attrs
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
name, ByteString
findex)
toTuple x :: NL80211Packet
x@(ErrorMsg{}) =
forall a. HasCallStack => String -> a
error (String
"Something happend while getting the interfaceList: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NL80211Packet
x)
toTuple (DoneMsg Header
_) = forall a. Maybe a
Nothing
getScanResults
:: NL80211Socket
-> Word32
-> IO [NL80211Packet]
getScanResults :: NL80211Socket -> Word32 -> IO [NL80211Packet]
getScanResults NL80211Socket
sock Word32
ifindex = NL80211Socket -> Word8 -> Bool -> Attributes -> IO [NL80211Packet]
query NL80211Socket
sock forall a. Num a => a
eNL80211_CMD_GET_SCAN Bool
True Attributes
attrs
where attrs :: Attributes
attrs = 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
ifindex)]
getConnectedWifi
:: NL80211Socket
-> Word32
-> IO [NL80211Packet]
getConnectedWifi :: NL80211Socket -> Word32 -> IO [NL80211Packet]
getConnectedWifi NL80211Socket
sock Word32
ifindex = forall a. (a -> Bool) -> [a] -> [a]
filter NL80211Packet -> Bool
isConn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NL80211Socket -> Word32 -> IO [NL80211Packet]
getScanResults NL80211Socket
sock Word32
ifindex
where isConn :: NL80211Packet -> Bool
isConn :: NL80211Packet -> Bool
isConn (Packet Header
_ GenlData NoData80211
_ Attributes
attrs) = Maybe ByteString -> Bool
hasConn 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 Attributes
attrs
isConn x :: NL80211Packet
x@(ErrorMsg Header
_ CInt
e NL80211Packet
_) = if CInt
e forall a. Eq a => a -> a -> Bool
== (-CInt
16)
then Bool
False
else forall a. HasCallStack => String -> a
error (String
"Something stupid happened" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NL80211Packet
x)
isConn (DoneMsg Header
_) = Bool
False
hasConn :: Maybe ByteString -> Bool
hasConn Maybe ByteString
Nothing = Bool
False
hasConn (Just ByteString
attrs) = forall k a. Ord k => k -> Map k a -> Bool
M.member forall a. Num a => a
eNL80211_BSS_STATUS forall a b. (a -> b) -> a -> b
$forall a b. Show a => Either a b -> b
getRight forall a b. (a -> b) -> a -> b
$forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes ByteString
attrs
getWifiAttributes :: NL80211Packet -> Maybe Attributes
getWifiAttributes :: NL80211Packet -> Maybe Attributes
getWifiAttributes (Packet Header
_ GenlData NoData80211
_ Attributes
attrs) = forall a b. Show a => Either a b -> b
getRight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getWifiEIDs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
eids
where bssattrs :: Maybe Attributes
bssattrs = forall a b. Show a => Either a b -> b
getRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a. Num a => a
eNL80211_ATTR_BSS Attributes
attrs
eids :: Maybe ByteString
eids = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a. Num a => a
eNL80211_BSS_INFORMATION_ELEMENTS forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attributes
bssattrs
getWifiAttributes x :: NL80211Packet
x@(ErrorMsg{}) = forall a. HasCallStack => String -> a
error (String
"Something stupid happened" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NL80211Packet
x)
getWifiAttributes (DoneMsg Header
_) = forall a. Maybe a
Nothing
getPacket :: NL80211Socket -> IO [NL80211Packet]
getPacket :: NL80211Socket -> IO [NL80211Packet]
getPacket (NLS NetlinkSocket
sock Word16
_) = forall a.
(Convertable a, Eq a, Show a) =>
NetlinkSocket -> IO [Packet a]
I.recvOne NetlinkSocket
sock