{-# 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
$c== :: CtrlAttrMcastGroup -> CtrlAttrMcastGroup -> Bool
== :: CtrlAttrMcastGroup -> CtrlAttrMcastGroup -> Bool
$c/= :: CtrlAttrMcastGroup -> CtrlAttrMcastGroup -> Bool
/= :: 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
$cshowsPrec :: Int -> CtrlAttrMcastGroup -> ShowS
showsPrec :: Int -> CtrlAttrMcastGroup -> ShowS
$cshow :: CtrlAttrMcastGroup -> String
show :: CtrlAttrMcastGroup -> String
$cshowList :: [CtrlAttrMcastGroup] -> ShowS
showList :: [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
$c== :: CtrlAttrOpData -> CtrlAttrOpData -> Bool
== :: CtrlAttrOpData -> CtrlAttrOpData -> Bool
$c/= :: CtrlAttrOpData -> CtrlAttrOpData -> Bool
/= :: 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
$cshowsPrec :: Int -> CtrlAttrOpData -> ShowS
showsPrec :: Int -> CtrlAttrOpData -> ShowS
$cshow :: CtrlAttrOpData -> String
show :: CtrlAttrOpData -> String
$cshowList :: [CtrlAttrOpData] -> ShowS
showList :: [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
$c== :: CtrlAttribute -> CtrlAttribute -> Bool
== :: CtrlAttribute -> CtrlAttribute -> Bool
$c/= :: CtrlAttribute -> CtrlAttribute -> Bool
/= :: 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
$cshowsPrec :: Int -> CtrlAttribute -> ShowS
showsPrec :: Int -> CtrlAttribute -> ShowS
$cshow :: CtrlAttribute -> String
show :: CtrlAttribute -> String
$cshowList :: [CtrlAttribute] -> ShowS
showList :: [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
$c== :: CtrlPacket -> CtrlPacket -> Bool
== :: CtrlPacket -> CtrlPacket -> Bool
$c/= :: CtrlPacket -> CtrlPacket -> Bool
/= :: CtrlPacket -> CtrlPacket -> Bool
Eq)
instance Show CtrlPacket where
show :: CtrlPacket -> String
show CtrlPacket
packet =
Header -> String
forall a. Show a => a -> String
show (CtrlPacket -> Header
ctrlHeader CtrlPacket
packet) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'\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]
++
String
"Attrs:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\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 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 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 :: forall a b. Either a b -> Maybe b
e2M (Right b
x) = b -> Maybe b
forall a. a -> Maybe a
Just b
x
e2M Either a b
_ = Maybe b
forall a. Maybe a
Nothing
getMcastGroupAttr :: (Int, ByteString) -> Maybe CtrlAttrMcastGroup
getMcastGroupAttr :: (Int, ByteString) -> Maybe CtrlAttrMcastGroup
getMcastGroupAttr (Int
_, 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. HasCallStack => [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 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 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
Either String Attributes
_ -> Maybe [CtrlAttrMcastGroup]
forall a. Maybe a
Nothing
getOpAttr :: (Int, ByteString) -> Maybe CtrlAttrOpData
getOpAttr :: (Int, ByteString) -> Maybe CtrlAttrOpData
getOpAttr (Int
_, 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 a. a -> Maybe a
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 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 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
Either String Attributes
_ -> Maybe [CtrlAttrOpData]
forall a. Maybe a
Nothing
getAttribute :: (Int, ByteString) -> CtrlAttribute
getAttribute :: (Int, ByteString) -> CtrlAttribute
getAttribute (Int
i, 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 Int
i 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 a b. (a -> b) -> Maybe a -> Maybe b
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. HasCallStack => [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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 Header
h GenlData NoData
g 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 CTRLPacket
_ = Maybe 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) = (Int
forall a. Num a => a
eCTRL_ATTR_UNSPEC , ByteString
x)
cATA (CTRL_ATTR_FAMILY_ID Word16
x) = (Int
forall a. Num a => a
eCTRL_ATTR_FAMILY_ID , Word16 -> ByteString
putW16 Word16
x)
cATA (CTRL_ATTR_FAMILY_NAME String
x) = (Int
forall a. Num a => a
eCTRL_ATTR_FAMILY_NAME , String -> ByteString
pack (String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"))
cATA (CTRL_ATTR_VERSION Word32
x) = (Int
forall a. Num a => a
eCTRL_ATTR_VERSION , Word32 -> ByteString
putW32 Word32
x)
cATA (CTRL_ATTR_HDRSIZE Word32
x) = (Int
forall a. Num a => a
eCTRL_ATTR_HDRSIZE , Word32 -> ByteString
putW32 Word32
x)
cATA (CTRL_ATTR_MAXATTR Word32
x) = (Int
forall a. Num a => a
eCTRL_ATTR_MAXATTR , Word32 -> ByteString
putW32 Word32
x)
cATA (CTRL_ATTR_OPS [CtrlAttrOpData]
_) = (Int
forall a. Num a => a
eCTRL_ATTR_OPS , ByteString
empty)
cATA (CTRL_ATTR_MCAST_GROUPS [CtrlAttrMcastGroup]
_) = (Int
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)= 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 Word16
fid = let
header :: Header
header = MessageType -> Word16 -> Word32 -> Word32 -> Header
Header MessageType
16 Word16
forall a. (Num a, Bits a) => a
fNLM_F_REQUEST Word32
42 Word32
0
geheader :: GenlHeader
geheader = Word8 -> Word8 -> GenlHeader
GenlHeader Word8
forall a. Num a => a
eCTRL_CMD_GETFAMILY Word8
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 String
name = let
header :: Header
header = MessageType -> Word16 -> Word32 -> Word32 -> Header
Header MessageType
16 Word16
forall a. (Num a, Bits a) => a
fNLM_F_REQUEST Word32
33 Word32
0
geheader :: GenlHeader
geheader = Word8 -> Word8 -> GenlHeader
GenlHeader Word8
forall a. Num a => a
eCTRL_CMD_GETFAMILY Word8
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 String
"\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 NetlinkSocket
s String
m = do
Maybe (Word16, [CtrlAttrMcastGroup])
may <- NetlinkSocket
-> String -> IO (Maybe (Word16, [CtrlAttrMcastGroup]))
getFamilyWithMulticastsS NetlinkSocket
s String
m
Maybe Word16 -> IO (Maybe Word16)
forall a. a -> IO a
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 a b. (a -> b) -> Maybe a -> Maybe b
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 NetlinkSocket
s 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 a. a -> IO a
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 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 = (IO (Word16, [CtrlAttrMcastGroup]) -> IO Word16)
-> (String -> IO (Word16, [CtrlAttrMcastGroup]))
-> String
-> IO Word16
forall a b. (a -> b) -> (String -> a) -> String -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Word16, [CtrlAttrMcastGroup]) -> Word16)
-> IO (Word16, [CtrlAttrMcastGroup]) -> IO Word16
forall a b. (a -> b) -> IO a -> IO b
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 NetlinkSocket
s String
m = do
Maybe (Word16, [CtrlAttrMcastGroup])
may <- NetlinkSocket
-> String -> IO (Maybe (Word16, [CtrlAttrMcastGroup]))
getFamilyWithMulticastsS NetlinkSocket
s String
m
(Word16, [CtrlAttrMcastGroup]) -> IO (Word16, [CtrlAttrMcastGroup])
forall a. a -> IO a
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 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 (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 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 MessageType
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) Word32
33 Word32
0
geheader :: GenlHeader
geheader = Word8 -> Word8 -> GenlHeader
GenlHeader Word8
forall a. Num a => a
eCTRL_CMD_GETFAMILY Word8
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 NetlinkSocket
sock 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 Header
_ GenlHeader
_ [CtrlAttribute]
attrs) = CtrlPacket -> Maybe CtrlPacket -> CtrlPacket
forall a. a -> Maybe a -> a
fromMaybe (String -> CtrlPacket
forall a. HasCallStack => String -> a
error String
"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 a. a -> IO a
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 [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
_ [] = Maybe Word32
forall a. Maybe a
Nothing
getMulticast String
name (CAMG String
gname Word32
gid:[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