{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-|
Module      : System.Linux.Netlink.GeNetlink.NL80211
Description : Implementation of NL80211
Maintainer  : ongy
Stability   : testing
Portability : Linux

This module providis utility functions for NL80211 subsystem.
For more information see /usr/include/linux/nl80211.h
-}
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)

-- The Netlink socket with Family Id, so we don't need as many arguments
-- everywhere
-- |Wrapper for 'NetlinkSocket' we also need the family id for messages we construct
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

-- |typedef for messages send by this mdoule
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)

-- |Get the raw fd from a 'NL80211Socket'. This can be used for eventing
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


-- |Create a 'NL80211Socket' this opens a genetlink socket and gets the family id
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


-- |Join a nl80211 multicast group by name
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


-- |Get the names of all multicast groups this nl80211 implementation provides
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 for NL80211 (see 'System.Linux.Netlink.queryOne')
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 for NL80211 (see 'System.Linux.Netlink.query')
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) = 
  --This init is ok because the name will always have a \0
  (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)


-- |Get the list of interfaces currently managed by NL80211
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


{- |get scan results

In testing this could be a big chunk of data when a scan just happened
or be pretty much only the currently connected wifi.

For more information about how this is structured look into kernel source
or just try it out.
-}
getScanResults
  :: NL80211Socket
  -> Word32 -- ^The id of the interface for which this should be looked up
  -> 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)]

{- |Get the information about the currently connected wifi(s).

This would technically work for multiple connected wifis, but since we only get
information about one interface this should only ever be emtpy on a singleton list.

For more information about how this is structured look into kernel soruce
or just try it out.
-}
getConnectedWifi
  :: NL80211Socket
  -> Word32 -- ^The id of the interface for which this should be looked up
  -> 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
  -- -16 is -EBUSY, which will be returned IF and (as far as I could see) only IF another dump
  -- is already in progress, so retrying should get something useful
  -- For other error codes we don't know for sure and want to return the error to the user
        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


-- |Get the EID attributes from a 'NL80211Packet' (for example from 'getConnectedWifi'
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


-- |NL80211 version of 'System.Linux.Netlink.recvOne'
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