{-# LANGUAGE CPP #-}
module System.Linux.Netlink.GeNetlink.Control
( CtrlAttribute(..)
, CtrlAttrMcastGroup(..)
, CtrlPacket(..)
, CTRLPacket
, ctrlPacketFromGenl
, CtrlAttrOpData(..)
, ctrlPackettoGenl
, getFamilyId
, getFamilyIdS
, getFamilyWithMulticasts
, getFamilyWithMulticastsS
, getMulticastGroups
, getMulticast
, getFamilie
, getFamilies
)
where
#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<$>))
#endif
import Data.Bits ((.|.))
import Data.Serialize.Get
import Data.Serialize.Put
import Data.List (intercalate)
import Data.Map (fromList, lookup, toList, Map)
import Data.ByteString (ByteString, append, empty)
import Data.ByteString.Char8 (pack, unpack)
import Data.Word (Word16, Word32)
import Data.Maybe (fromMaybe, mapMaybe)
import Prelude hiding (lookup)
import System.Linux.Netlink
import System.Linux.Netlink.Constants
import System.Linux.Netlink.GeNetlink
import System.Linux.Netlink.GeNetlink.Constants
import System.Linux.Netlink.Helpers (g32, g16)
data CtrlAttrMcastGroup = CAMG {CtrlAttrMcastGroup -> String
grpName :: String, CtrlAttrMcastGroup -> Word32
grpId :: Word32 } deriving (CtrlAttrMcastGroup -> CtrlAttrMcastGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CtrlAttrMcastGroup -> CtrlAttrMcastGroup -> Bool
$c/= :: CtrlAttrMcastGroup -> CtrlAttrMcastGroup -> Bool
== :: CtrlAttrMcastGroup -> CtrlAttrMcastGroup -> Bool
$c== :: CtrlAttrMcastGroup -> CtrlAttrMcastGroup -> Bool
Eq, Int -> CtrlAttrMcastGroup -> ShowS
[CtrlAttrMcastGroup] -> ShowS
CtrlAttrMcastGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CtrlAttrMcastGroup] -> ShowS
$cshowList :: [CtrlAttrMcastGroup] -> ShowS
show :: CtrlAttrMcastGroup -> String
$cshow :: CtrlAttrMcastGroup -> String
showsPrec :: Int -> CtrlAttrMcastGroup -> ShowS
$cshowsPrec :: Int -> CtrlAttrMcastGroup -> ShowS
Show)
data CtrlAttrOpData = CAO {CtrlAttrOpData -> Word32
opId :: Word32, CtrlAttrOpData -> Word32
opFlags :: Word32 } deriving (CtrlAttrOpData -> CtrlAttrOpData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CtrlAttrOpData -> CtrlAttrOpData -> Bool
$c/= :: CtrlAttrOpData -> CtrlAttrOpData -> Bool
== :: CtrlAttrOpData -> CtrlAttrOpData -> Bool
$c== :: CtrlAttrOpData -> CtrlAttrOpData -> Bool
Eq, Int -> CtrlAttrOpData -> ShowS
[CtrlAttrOpData] -> ShowS
CtrlAttrOpData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CtrlAttrOpData] -> ShowS
$cshowList :: [CtrlAttrOpData] -> ShowS
show :: CtrlAttrOpData -> String
$cshow :: CtrlAttrOpData -> String
showsPrec :: Int -> CtrlAttrOpData -> ShowS
$cshowsPrec :: Int -> CtrlAttrOpData -> ShowS
Show)
data CtrlAttribute =
CTRL_ATTR_UNSPEC ByteString |
CTRL_ATTR_FAMILY_ID Word16 |
CTRL_ATTR_FAMILY_NAME String |
CTRL_ATTR_VERSION Word32 |
CTRL_ATTR_HDRSIZE Word32 |
CTRL_ATTR_MAXATTR Word32 |
CTRL_ATTR_OPS [CtrlAttrOpData] |
CTRL_ATTR_MCAST_GROUPS [CtrlAttrMcastGroup] |
CTRL_ATTR_UNKNOWN Int ByteString
deriving (CtrlAttribute -> CtrlAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CtrlAttribute -> CtrlAttribute -> Bool
$c/= :: CtrlAttribute -> CtrlAttribute -> Bool
== :: CtrlAttribute -> CtrlAttribute -> Bool
$c== :: CtrlAttribute -> CtrlAttribute -> Bool
Eq, Int -> CtrlAttribute -> ShowS
[CtrlAttribute] -> ShowS
CtrlAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CtrlAttribute] -> ShowS
$cshowList :: [CtrlAttribute] -> ShowS
show :: CtrlAttribute -> String
$cshow :: CtrlAttribute -> String
showsPrec :: Int -> CtrlAttribute -> ShowS
$cshowsPrec :: Int -> CtrlAttribute -> ShowS
Show)
data CtrlPacket = CtrlPacket
{
:: Header
, :: GenlHeader
, CtrlPacket -> [CtrlAttribute]
ctrlAttributes :: [CtrlAttribute]
} deriving (CtrlPacket -> CtrlPacket -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CtrlPacket -> CtrlPacket -> Bool
$c/= :: CtrlPacket -> CtrlPacket -> Bool
== :: CtrlPacket -> CtrlPacket -> Bool
$c== :: CtrlPacket -> CtrlPacket -> Bool
Eq)
instance Show CtrlPacket where
show :: CtrlPacket -> String
show CtrlPacket
packet =
forall a. Show a => a -> String
show (CtrlPacket -> Header
ctrlHeader CtrlPacket
packet) forall a. [a] -> [a] -> [a]
++ Char
'\n'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show (CtrlPacket -> GenlHeader
ctrlGeHeader CtrlPacket
packet) forall a. [a] -> [a] -> [a]
++
String
"Attrs:\n" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (CtrlPacket -> [CtrlAttribute]
ctrlAttributes CtrlPacket
packet))
type CTRLPacket = GenlPacket NoData
getW16 :: ByteString -> Maybe Word16
getW16 :: ByteString -> Maybe Word16
getW16 ByteString
x = forall a b. Either a b -> Maybe b
e2M (forall a. Get a -> ByteString -> Either String a
runGet Get Word16
g16 ByteString
x)
getW32 :: ByteString -> Maybe Word32
getW32 :: ByteString -> Maybe Word32
getW32 ByteString
x = forall a b. Either a b -> Maybe b
e2M (forall a. Get a -> ByteString -> Either String a
runGet Get Word32
g32 ByteString
x)
e2M :: Either a b -> Maybe b
e2M :: forall a b. Either a b -> Maybe b
e2M (Right b
x) = forall a. a -> Maybe a
Just b
x
e2M Either a b
_ = forall a. Maybe a
Nothing
getMcastGroupAttr :: (Int, ByteString) -> Maybe CtrlAttrMcastGroup
getMcastGroupAttr :: (Int, ByteString) -> Maybe CtrlAttrMcastGroup
getMcastGroupAttr (Int
_, ByteString
x) = do
Attributes
attrs <- forall a b. Either a b -> Maybe b
e2M forall a b. (a -> b) -> a -> b
$forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes ByteString
x
ByteString
name <- forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eCTRL_ATTR_MCAST_GRP_NAME Attributes
attrs
ByteString
fid <- forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eCTRL_ATTR_MCAST_GRP_ID Attributes
attrs
String -> Word32 -> CtrlAttrMcastGroup
CAMG (forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpack forall a b. (a -> b) -> a -> b
$ ByteString
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Word32
getW32 ByteString
fid
getMcastGroupAttrs :: ByteString -> Maybe [CtrlAttrMcastGroup]
getMcastGroupAttrs :: ByteString -> Maybe [CtrlAttrMcastGroup]
getMcastGroupAttrs ByteString
x = case forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes ByteString
x of
(Right Attributes
y) -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, ByteString) -> Maybe CtrlAttrMcastGroup
getMcastGroupAttr forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
toList Attributes
y
Either String Attributes
_ -> forall a. Maybe a
Nothing
getOpAttr :: (Int, ByteString) -> Maybe CtrlAttrOpData
getOpAttr :: (Int, ByteString) -> Maybe CtrlAttrOpData
getOpAttr (Int
_, ByteString
x) = do
Attributes
attrs <- forall a b. Either a b -> Maybe b
e2M forall a b. (a -> b) -> a -> b
$forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes ByteString
x
Word32
oid <- ByteString -> Maybe Word32
getW32 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eCTRL_ATTR_OP_ID Attributes
attrs
Word32
ofl <- ByteString -> Maybe Word32
getW32 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eCTRL_ATTR_OP_FLAGS Attributes
attrs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> CtrlAttrOpData
CAO Word32
oid Word32
ofl
getOpAttrs :: ByteString -> Maybe [CtrlAttrOpData]
getOpAttrs :: ByteString -> Maybe [CtrlAttrOpData]
getOpAttrs ByteString
x = case forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes ByteString
x of
(Right Attributes
y) -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, ByteString) -> Maybe CtrlAttrOpData
getOpAttr forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
toList Attributes
y
Either String Attributes
_ -> forall a. Maybe a
Nothing
getAttribute :: (Int, ByteString) -> CtrlAttribute
getAttribute :: (Int, ByteString) -> CtrlAttribute
getAttribute (Int
i, ByteString
x) = forall a. a -> Maybe a -> a
fromMaybe (Int -> ByteString -> CtrlAttribute
CTRL_ATTR_UNKNOWN Int
i ByteString
x) forall a b. (a -> b) -> a -> b
$Int -> ByteString -> Maybe CtrlAttribute
makeAttribute Int
i ByteString
x
makeAttribute :: Int -> ByteString -> Maybe CtrlAttribute
makeAttribute :: Int -> ByteString -> Maybe CtrlAttribute
makeAttribute Int
i ByteString
x
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eCTRL_ATTR_UNSPEC = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ByteString -> CtrlAttribute
CTRL_ATTR_UNSPEC ByteString
x
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eCTRL_ATTR_FAMILY_ID = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> CtrlAttribute
CTRL_ATTR_FAMILY_ID forall a b. (a -> b) -> a -> b
$ByteString -> Maybe Word16
getW16 ByteString
x
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eCTRL_ATTR_FAMILY_NAME = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CtrlAttribute
CTRL_ATTR_FAMILY_NAME forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ByteString -> String
unpack ByteString
x
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eCTRL_ATTR_VERSION = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> CtrlAttribute
CTRL_ATTR_VERSION forall a b. (a -> b) -> a -> b
$ByteString -> Maybe Word32
getW32 ByteString
x
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eCTRL_ATTR_HDRSIZE = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> CtrlAttribute
CTRL_ATTR_HDRSIZE forall a b. (a -> b) -> a -> b
$ByteString -> Maybe Word32
getW32 ByteString
x
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eCTRL_ATTR_MAXATTR = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> CtrlAttribute
CTRL_ATTR_MAXATTR forall a b. (a -> b) -> a -> b
$ByteString -> Maybe Word32
getW32 ByteString
x
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eCTRL_ATTR_OPS = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CtrlAttrOpData] -> CtrlAttribute
CTRL_ATTR_OPS forall a b. (a -> b) -> a -> b
$ByteString -> Maybe [CtrlAttrOpData]
getOpAttrs ByteString
x
| Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eCTRL_ATTR_MCAST_GROUPS = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CtrlAttrMcastGroup] -> CtrlAttribute
CTRL_ATTR_MCAST_GROUPS forall a b. (a -> b) -> a -> b
$ByteString -> Maybe [CtrlAttrMcastGroup]
getMcastGroupAttrs ByteString
x
| Bool
otherwise = forall a. Maybe a
Nothing
ctrlAttributesFromAttributes :: Map Int ByteString -> [CtrlAttribute]
ctrlAttributesFromAttributes :: Attributes -> [CtrlAttribute]
ctrlAttributesFromAttributes = forall a b. (a -> b) -> [a] -> [b]
map (Int, ByteString) -> CtrlAttribute
getAttribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
toList
ctrlPacketFromGenl :: CTRLPacket -> Maybe CtrlPacket
ctrlPacketFromGenl :: CTRLPacket -> Maybe CtrlPacket
ctrlPacketFromGenl (Packet Header
h GenlData NoData
g Attributes
attrs) = forall a. a -> Maybe a
Just (Header -> GenlHeader -> [CtrlAttribute] -> CtrlPacket
CtrlPacket Header
h (forall a. GenlData a -> GenlHeader
genlDataHeader GenlData NoData
g) [CtrlAttribute]
a)
where a :: [CtrlAttribute]
a = Attributes -> [CtrlAttribute]
ctrlAttributesFromAttributes Attributes
attrs
ctrlPacketFromGenl CTRLPacket
_ = forall a. Maybe a
Nothing
putW16 :: Word16 -> ByteString
putW16 :: Word16 -> ByteString
putW16 Word16
x = Put -> ByteString
runPut (Putter Word16
putWord16host Word16
x)
putW32 :: Word32 -> ByteString
putW32 :: Word32 -> ByteString
putW32 Word32
x = Put -> ByteString
runPut (Putter Word32
putWord32host Word32
x)
cATA :: CtrlAttribute -> (Int, ByteString)
cATA :: CtrlAttribute -> (Int, ByteString)
cATA (CTRL_ATTR_UNSPEC ByteString
x) = (forall a. Num a => a
eCTRL_ATTR_UNSPEC , ByteString
x)
cATA (CTRL_ATTR_FAMILY_ID Word16
x) = (forall a. Num a => a
eCTRL_ATTR_FAMILY_ID , Word16 -> ByteString
putW16 Word16
x)
cATA (CTRL_ATTR_FAMILY_NAME String
x) = (forall a. Num a => a
eCTRL_ATTR_FAMILY_NAME , String -> ByteString
pack (String
x forall a. [a] -> [a] -> [a]
++ String
"\n"))
cATA (CTRL_ATTR_VERSION Word32
x) = (forall a. Num a => a
eCTRL_ATTR_VERSION , Word32 -> ByteString
putW32 Word32
x)
cATA (CTRL_ATTR_HDRSIZE Word32
x) = (forall a. Num a => a
eCTRL_ATTR_HDRSIZE , Word32 -> ByteString
putW32 Word32
x)
cATA (CTRL_ATTR_MAXATTR Word32
x) = (forall a. Num a => a
eCTRL_ATTR_MAXATTR , Word32 -> ByteString
putW32 Word32
x)
cATA (CTRL_ATTR_OPS [CtrlAttrOpData]
_) = (forall a. Num a => a
eCTRL_ATTR_OPS , ByteString
empty)
cATA (CTRL_ATTR_MCAST_GROUPS [CtrlAttrMcastGroup]
_) = (forall a. Num a => a
eCTRL_ATTR_MCAST_GROUPS, ByteString
empty)
cATA (CTRL_ATTR_UNKNOWN Int
i ByteString
x) = (Int
i , ByteString
x)
ctrlAttributesToAttribute :: CtrlAttribute -> (Int, ByteString)
ctrlAttributesToAttribute :: CtrlAttribute -> (Int, ByteString)
ctrlAttributesToAttribute = CtrlAttribute -> (Int, ByteString)
cATA
ctrlPackettoGenl :: CtrlPacket -> CTRLPacket
ctrlPackettoGenl :: CtrlPacket -> CTRLPacket
ctrlPackettoGenl (CtrlPacket Header
h GenlHeader
g [CtrlAttribute]
attrs)= forall a. Header -> a -> Attributes -> Packet a
Packet Header
h (forall a. GenlHeader -> a -> GenlData a
GenlData GenlHeader
g NoData
NoData) Attributes
a
where a :: Attributes
a = forall k a. Ord k => [(k, a)] -> Map k a
fromList forall a b. (a -> b) -> a -> b
$forall a b. (a -> b) -> [a] -> [b]
map CtrlAttribute -> (Int, ByteString)
ctrlAttributesToAttribute [CtrlAttribute]
attrs
familyMcastRequest :: Word16 -> CTRLPacket
familyMcastRequest :: Word16 -> CTRLPacket
familyMcastRequest Word16
fid = let
header :: Header
header = MessageType -> Word16 -> Word32 -> Word32 -> Header
Header MessageType
16 forall a. (Num a, Bits a) => a
fNLM_F_REQUEST Word32
42 Word32
0
geheader :: GenlHeader
geheader = Word8 -> Word8 -> GenlHeader
GenlHeader forall a. Num a => a
eCTRL_CMD_GETFAMILY Word8
0
attrs :: Attributes
attrs = forall k a. Ord k => [(k, a)] -> Map k a
fromList [(forall a. Num a => a
eCTRL_ATTR_FAMILY_ID, Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$Putter Word16
putWord16host Word16
fid)] in
forall a. Header -> a -> Attributes -> Packet a
Packet Header
header (forall a. GenlHeader -> a -> GenlData a
GenlData GenlHeader
geheader NoData
NoData) Attributes
attrs
familyIdRequest :: String -> CTRLPacket
familyIdRequest :: String -> CTRLPacket
familyIdRequest String
name = let
header :: Header
header = MessageType -> Word16 -> Word32 -> Word32 -> Header
Header MessageType
16 forall a. (Num a, Bits a) => a
fNLM_F_REQUEST Word32
33 Word32
0
geheader :: GenlHeader
geheader = Word8 -> Word8 -> GenlHeader
GenlHeader forall a. Num a => a
eCTRL_CMD_GETFAMILY Word8
0
attrs :: Attributes
attrs = forall k a. Ord k => [(k, a)] -> Map k a
fromList [(forall a. Num a => a
eCTRL_ATTR_FAMILY_NAME, String -> ByteString
pack String
name ByteString -> ByteString -> ByteString
`append` String -> ByteString
pack String
"\0")] in
forall a. Header -> a -> Attributes -> Packet a
Packet Header
header (forall a. GenlHeader -> a -> GenlData a
GenlData GenlHeader
geheader NoData
NoData) Attributes
attrs
getFamilyIdS :: NetlinkSocket -> String -> IO (Maybe Word16)
getFamilyIdS :: NetlinkSocket -> String -> IO (Maybe Word16)
getFamilyIdS NetlinkSocket
s String
m = do
Maybe (Word16, [CtrlAttrMcastGroup])
may <- NetlinkSocket
-> String -> IO (Maybe (Word16, [CtrlAttrMcastGroup]))
getFamilyWithMulticastsS NetlinkSocket
s String
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Maybe (Word16, [CtrlAttrMcastGroup])
may
getFamilyWithMulticastsS :: NetlinkSocket -> String -> IO (Maybe (Word16, [CtrlAttrMcastGroup]))
getFamilyWithMulticastsS :: NetlinkSocket
-> String -> IO (Maybe (Word16, [CtrlAttrMcastGroup]))
getFamilyWithMulticastsS NetlinkSocket
s String
m = do
CTRLPacket
packet <- forall a.
(Convertable a, Eq a, Show a) =>
NetlinkSocket -> Packet a -> IO (Packet a)
queryOne NetlinkSocket
s (String -> CTRLPacket
familyIdRequest String
m)
let ctrl :: Maybe CtrlPacket
ctrl = CTRLPacket -> Maybe CtrlPacket
ctrlPacketFromGenl CTRLPacket
packet
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [CtrlAttribute] -> (Word16, [CtrlAttrMcastGroup])
makeTupl forall b c a. (b -> c) -> (a -> b) -> a -> c
. CtrlPacket -> [CtrlAttribute]
ctrlAttributes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CtrlPacket
ctrl
where getIdFromList :: [CtrlAttribute] -> Word16
getIdFromList (CTRL_ATTR_FAMILY_ID Word16
x:[CtrlAttribute]
_) = Word16
x
getIdFromList (CtrlAttribute
_:[CtrlAttribute]
xs) = [CtrlAttribute] -> Word16
getIdFromList [CtrlAttribute]
xs
getIdFromList [] = -Word16
1
makeTupl :: [CtrlAttribute] -> (Word16, [CtrlAttrMcastGroup])
makeTupl [CtrlAttribute]
attrs = ([CtrlAttribute] -> Word16
getIdFromList [CtrlAttribute]
attrs, [CtrlAttribute] -> [CtrlAttrMcastGroup]
getMCFromList [CtrlAttribute]
attrs)
getFamilyId :: NetlinkSocket -> String -> IO Word16
getFamilyId :: NetlinkSocket -> String -> IO Word16
getFamilyId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetlinkSocket -> String -> IO (Word16, [CtrlAttrMcastGroup])
getFamilyWithMulticasts
getFamilyWithMulticasts :: NetlinkSocket -> String -> IO (Word16, [CtrlAttrMcastGroup])
getFamilyWithMulticasts :: NetlinkSocket -> String -> IO (Word16, [CtrlAttrMcastGroup])
getFamilyWithMulticasts NetlinkSocket
s String
m = do
Maybe (Word16, [CtrlAttrMcastGroup])
may <- NetlinkSocket
-> String -> IO (Maybe (Word16, [CtrlAttrMcastGroup]))
getFamilyWithMulticastsS NetlinkSocket
s String
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Could not find family") Maybe (Word16, [CtrlAttrMcastGroup])
may
getFamilie :: NetlinkSocket -> String -> IO (Maybe CtrlPacket)
getFamilie :: NetlinkSocket -> String -> IO (Maybe CtrlPacket)
getFamilie NetlinkSocket
sock String
name =
CTRLPacket -> Maybe CtrlPacket
ctrlPacketFromGenl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(Convertable a, Eq a, Show a) =>
NetlinkSocket -> Packet a -> IO (Packet a)
queryOne NetlinkSocket
sock (String -> CTRLPacket
familyIdRequest String
name)
getFamilies :: NetlinkSocket -> IO [CtrlPacket]
getFamilies :: NetlinkSocket -> IO [CtrlPacket]
getFamilies NetlinkSocket
sock = do
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CTRLPacket -> Maybe CtrlPacket
ctrlPacketFromGenl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(Convertable a, Eq a, Show a) =>
NetlinkSocket -> Packet a -> IO [Packet a]
query NetlinkSocket
sock CTRLPacket
familiesRequest
where familiesRequest :: CTRLPacket
familiesRequest = let header :: Header
header = MessageType -> Word16 -> Word32 -> Word32 -> Header
Header MessageType
16 (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_ROOT forall a. Bits a => a -> a -> a
.|. forall a. (Num a, Bits a) => a
fNLM_F_MATCH) Word32
33 Word32
0
geheader :: GenlHeader
geheader = Word8 -> Word8 -> GenlHeader
GenlHeader forall a. Num a => a
eCTRL_CMD_GETFAMILY Word8
0
attrs :: Map Int a
attrs = forall k a. Ord k => [(k, a)] -> Map k a
fromList [] in
forall a. Header -> a -> Attributes -> Packet a
Packet Header
header (forall a. GenlHeader -> a -> GenlData a
GenlData GenlHeader
geheader NoData
NoData) forall {a}. Map Int a
attrs
getMulticastGroups :: NetlinkSocket -> Word16 -> IO [CtrlAttrMcastGroup]
getMulticastGroups :: NetlinkSocket -> Word16 -> IO [CtrlAttrMcastGroup]
getMulticastGroups NetlinkSocket
sock Word16
fid = do
CTRLPacket
packet <- forall a.
(Convertable a, Eq a, Show a) =>
NetlinkSocket -> Packet a -> IO (Packet a)
queryOne NetlinkSocket
sock (Word16 -> CTRLPacket
familyMcastRequest Word16
fid)
let (CtrlPacket Header
_ GenlHeader
_ [CtrlAttribute]
attrs) = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Got infalid family id for request") forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTRLPacket -> Maybe CtrlPacket
ctrlPacketFromGenl forall a b. (a -> b) -> a -> b
$CTRLPacket
packet
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$[CtrlAttribute] -> [CtrlAttrMcastGroup]
getMCFromList [CtrlAttribute]
attrs
getMCFromList :: [CtrlAttribute] -> [CtrlAttrMcastGroup]
getMCFromList :: [CtrlAttribute] -> [CtrlAttrMcastGroup]
getMCFromList (CTRL_ATTR_MCAST_GROUPS [CtrlAttrMcastGroup]
x:[CtrlAttribute]
_) = [CtrlAttrMcastGroup]
x
getMCFromList (CtrlAttribute
_:[CtrlAttribute]
xs) = [CtrlAttribute] -> [CtrlAttrMcastGroup]
getMCFromList [CtrlAttribute]
xs
getMCFromList [] = []
getMulticast :: String -> [CtrlAttrMcastGroup] -> Maybe Word32
getMulticast :: String -> [CtrlAttrMcastGroup] -> Maybe Word32
getMulticast String
_ [] = forall a. Maybe a
Nothing
getMulticast String
name (CAMG String
gname Word32
gid:[CtrlAttrMcastGroup]
xs) = if String
name forall a. Eq a => a -> a -> Bool
== String
gname
then forall a. a -> Maybe a
Just Word32
gid
else String -> [CtrlAttrMcastGroup] -> Maybe Word32
getMulticast String
name [CtrlAttrMcastGroup]
xs