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