{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}

{-|
Module      : System.Linux.Netlink.Route
Description : The implementation for netlinks route family
Maintainer  : ongy
Stability   : testing
Portability : Linux

This module provides wrappers for functionality provided by the netlink route family
-}
module System.Linux.Netlink.Route
    (
      Packet
    , RoutePacket

    , getRoutePackets
    , Message(..)
    
    , getLinkAddress
    , getLinkBroadcast
    , getLinkName
    , getLinkMTU
    , getLinkQDisc
    , getLinkTXQLen
    , getIFAddr
    , getLLAddr
    , getDstAddr

    , putLinkAddress
    , putLinkBroadcast
    , putLinkName
    , putLinkMTU
    , putLinkQDisc
    , putLinkTXQLen
    ) where

import Prelude hiding (length, lookup, init)

#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<$>), (<*>))
#endif

import qualified Data.ByteString as BS (length)
import Data.ByteString.Char8 (ByteString, append, init, pack, unpack)
import Data.Char (chr, ord)
import Data.List (intersperse)
import Data.Map (insert, lookup, toList)
import Data.Serialize.Get
import Data.Serialize.Put
import Data.Word (Word8, Word16, Word32)
import Data.Int (Int32)

import System.Linux.Netlink.Constants
import System.Linux.Netlink
import System.Linux.Netlink.Helpers
import System.Linux.Netlink.Route.LinkStat

-- |The static data for route messages
data Message = NLinkMsg
    {
      Message -> LinkType
interfaceType  :: LinkType
    , Message -> Word32
interfaceIndex :: Word32
    , Message -> Word32
interfaceFlags :: Word32 -- ^ System.Linux.Netlink.Constants.fIFF_* flags
    }
             | NAddrMsg
    {
      Message -> AddressFamily
addrFamily         :: AddressFamily
    , Message -> Word8
addrMaskLength     :: Word8
    , Message -> Word8
addrFlags          :: Word8
    , Message -> Word8
addrScope          :: Word8
    , Message -> Word32
addrInterfaceIndex :: Word32
    } 
             | NNeighMsg
    { Message -> Word8
neighFamily  :: Word8 -- ^ One of System.Linux.Netlink.Constants.eAF_* values
    , Message -> Int32
neighIfindex :: Int32
    , Message -> Word16
neighState   :: Word16 -- ^ System.Linux.Netlink.Constants.fNUD_* flags
    , Message -> Word8
neighFlags   :: Word8
    , Message -> Word8
neighType    :: Word8
    } deriving (Message -> Message -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq)

instance Show Message where
  show :: Message -> [Char]
show (NLinkMsg LinkType
t Word32
i Word32
f) =
    [Char]
"LinkMessage. Type: " forall a. [a] -> [a] -> [a]
++ forall a. (Num a, Show a, Eq a) => a -> [Char]
showLinkType LinkType
t forall a. [a] -> [a] -> [a]
++ [Char]
", Index: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word32
i forall a. [a] -> [a] -> [a]
++ [Char]
", Flags: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word32
f
  show (NAddrMsg AddressFamily
f Word8
l Word8
fl Word8
s Word32
i) =
    [Char]
"AddrMessage. Family: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AddressFamily
f forall a. [a] -> [a] -> [a]
++ [Char]
", MLength: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
l forall a. [a] -> [a] -> [a]
++ [Char]
", Flags: " forall a. [a] -> [a] -> [a]
++ 
    forall a. Show a => a -> [Char]
show Word8
fl forall a. [a] -> [a] -> [a]
++ [Char]
", Scope: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
s forall a. [a] -> [a] -> [a]
++ [Char]
", Index: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word32
i
  show (NNeighMsg Word8
f Int32
i Word16
s Word8
fl Word8
t) =
    [Char]
"NeighMessage. Family: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
f forall a. [a] -> [a] -> [a]
++ [Char]
", Index: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int32
i forall a. [a] -> [a] -> [a]
++ [Char]
", State: " forall a. [a] -> [a] -> [a]
++ 
    forall a. Show a => a -> [Char]
show Word16
s forall a. [a] -> [a] -> [a]
++ [Char]
", Flags: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
fl forall a. [a] -> [a] -> [a]
++ [Char]
", Type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
t

instance Convertable Message where
  getGet :: MessageType -> Get Message
getGet = MessageType -> Get Message
getMessage
  getPut :: Message -> Put
getPut = Message -> Put
putMessage

-- |Typedef for route messages
type RoutePacket = Packet Message

showRouteHeader :: Header -> String
showRouteHeader :: Header -> [Char]
showRouteHeader (Header MessageType
t Word16
f Word32
s Word32
p) =
  [Char]
"Type: " forall a. [a] -> [a] -> [a]
++ forall a. (Num a, Show a, Eq a) => a -> [Char]
showMessageType MessageType
t forall a. [a] -> [a] -> [a]
++ [Char]
", Flags: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> [Char]
show Word16
f) forall a. [a] -> [a] -> [a]
++ [Char]
", Seq: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word32
s forall a. [a] -> [a] -> [a]
++ [Char]
", Pid: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word32
p


instance Show RoutePacket where
  showList :: [RoutePacket] -> ShowS
showList [RoutePacket]
xs = ((forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [Char]
"===\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$[RoutePacket]
xs) forall a. [a] -> [a] -> [a]
++)
  show :: RoutePacket -> [Char]
show (Packet Header
hdr Message
cus Attributes
attrs) =
    [Char]
"RoutePacket: " forall a. [a] -> [a] -> [a]
++ Header -> [Char]
showRouteHeader Header
hdr forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
    forall a. Show a => a -> [Char]
show Message
cus forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
    --TODO: is this the case every time? maybe match on other to get which enum to use
    [Char]
"Attrs: \n" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MessageType -> (Int, ByteString) -> [Char]
showMsgAttr (Header -> MessageType
messageType Header
hdr)) (forall k a. Map k a -> [(k, a)]
toList Attributes
attrs) forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
  show RoutePacket
p = forall a. Show a => Packet a -> [Char]
showPacket RoutePacket
p


showMsgAttr :: MessageType -> (Int, ByteString) -> String
showMsgAttr :: MessageType -> (Int, ByteString) -> [Char]
showMsgAttr MessageType
msgType
  | MessageType
msgType forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_NEWNEIGH = (Int, ByteString) -> [Char]
showNeighAttr
  | MessageType
msgType forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_DELNEIGH = (Int, ByteString) -> [Char]
showNeighAttr
  | MessageType
msgType forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_GETNEIGH = (Int, ByteString) -> [Char]
showNeighAttr
  | Bool
otherwise = (Int, ByteString) -> [Char]
showLinkAttr --default to original behavior

showNeighAttr :: (Int, ByteString) -> String
showNeighAttr :: (Int, ByteString) -> [Char]
showNeighAttr = (Int -> [Char]) -> (Int, ByteString) -> [Char]
showAttr forall a. (Num a, Show a, Eq a) => a -> [Char]
showNeighAttrType

showLinkAttr :: (Int, ByteString) -> String
showLinkAttr :: (Int, ByteString) -> [Char]
showLinkAttr (Int
i, ByteString
v)
  | Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eIFLA_STATS64 = [Char]
"IFLA_STATS64:\n" forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
showStats64 ByteString
v
  | Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eIFLA_STATS = [Char]
"IFLA_STATS:\n" forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
showStats32 ByteString
v
  | Int
i forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eIFLA_AF_SPEC = 
    [Char]
"eIFLA_AF_SPEC: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
v) forall a. [a] -> [a] -> [a]
++ Char
'\n'forall a. a -> [a] -> [a]
:ShowS
indent (ByteString -> [Char]
showAfSpec ByteString
v)
  | Bool
otherwise = (Int -> [Char]) -> (Int, ByteString) -> [Char]
showAttr forall a. (Num a, Show a, Eq a) => a -> [Char]
showLinkAttrType (Int
i, ByteString
v)

showStats64 :: ByteString -> String
showStats64 :: ByteString -> [Char]
showStats64 ByteString
bs = case forall a. Get a -> ByteString -> Either [Char] a
runGet Get LinkStat
getLinkStat64 ByteString
bs of
  (Left [Char]
x) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Could not marshall LinkStat64: " forall a. [a] -> [a] -> [a]
++ [Char]
x)
  (Right LinkStat
x) -> forall a. Show a => a -> [Char]
show LinkStat
x forall a. [a] -> [a] -> [a]
++ [Char]
"\n"

showStats32 :: ByteString -> String
showStats32 :: ByteString -> [Char]
showStats32 ByteString
bs = case forall a. Get a -> ByteString -> Either [Char] a
runGet Get LinkStat
getLinkStat32 ByteString
bs of
  (Left [Char]
x) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Could not marshall LinkStat32: " forall a. [a] -> [a] -> [a]
++ [Char]
x)
  (Right LinkStat
x) -> forall a. Show a => a -> [Char]
show LinkStat
x forall a. [a] -> [a] -> [a]
++ [Char]
"\n"


showAfSpec :: ByteString -> String
showAfSpec :: ByteString -> [Char]
showAfSpec ByteString
bs = case forall a. Get a -> ByteString -> Either [Char] a
runGet Get Attributes
getAttributes ByteString
bs of
  (Left [Char]
x) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Could not marshall AfSpec: " forall a. [a] -> [a] -> [a]
++ [Char]
x)
  (Right Attributes
attrs) -> 
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
i, ByteString
v) -> forall a. (Num a, Show a, Eq a) => a -> [Char]
showAddressFamily Int
i forall a. [a] -> [a] -> [a]
++ Char
'\n'forall a. a -> [a] -> [a]
: ShowS
indent (ByteString -> [Char]
showAfSpec' ByteString
v)) (forall k a. Map k a -> [(k, a)]
toList Attributes
attrs)

showAfSpec' :: ByteString -> String
showAfSpec' :: ByteString -> [Char]
showAfSpec' ByteString
bs = case forall a. Get a -> ByteString -> Either [Char] a
runGet Get Attributes
getAttributes ByteString
bs of
  (Left [Char]
x) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Could not marshall AfSpec': " forall a. [a] -> [a] -> [a]
++ [Char]
x)
  (Right Attributes
attrs) -> Attributes -> [Char]
showNLAttrs Attributes
attrs


--
-- New generic stuffs
--

getMessage :: MessageType -> Get Message
getMessage :: MessageType -> Get Message
getMessage MessageType
msgtype | MessageType
msgtype forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_NEWLINK = Get Message
getMessageLink
                   | MessageType
msgtype forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_GETLINK = Get Message
getMessageLink
                   | MessageType
msgtype forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_DELLINK = Get Message
getMessageLink
                   | MessageType
msgtype forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_NEWADDR = Get Message
getMessageAddr
                   | MessageType
msgtype forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_GETADDR = Get Message
getMessageAddr
                   | MessageType
msgtype forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_DELADDR = Get Message
getMessageAddr

                   | MessageType
msgtype forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_GETNEIGH = Get Message
getMessageNeigh
                   | MessageType
msgtype forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_NEWNEIGH = Get Message
getMessageNeigh
                   | MessageType
msgtype forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
eRTM_DELNEIGH = Get Message
getMessageNeigh

                   | Bool
otherwise               =
                       forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Can't decode message " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show MessageType
msgtype

getMessageLink :: Get Message
getMessageLink :: Get Message
getMessageLink = do
    Int -> Get ()
skip Int
2
    LinkType
ty    <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
g16
    Word32
idx   <- Get Word32
g32
    Word32
flags <- Get Word32
g32
    Int -> Get ()
skip Int
4
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LinkType -> Word32 -> Word32 -> Message
NLinkMsg LinkType
ty Word32
idx Word32
flags

getMessageAddr :: Get Message
getMessageAddr :: Get Message
getMessageAddr = do
    AddressFamily
fam <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
g8
    Word8
maskLen <- Get Word8
g8
    Word8
flags <- Get Word8
g8
    Word8
scope <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
g8
    Word32
idx <- Get Word32
g32
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AddressFamily -> Word8 -> Word8 -> Word8 -> Word32 -> Message
NAddrMsg AddressFamily
fam Word8
maskLen Word8
flags Word8
scope Word32
idx

getMessageNeigh :: Get Message
getMessageNeigh :: Get Message
getMessageNeigh = Word8 -> Int32 -> Word16 -> Word8 -> Word8 -> Message
NNeighMsg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
g8
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Get ()
skip Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
g32)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
g16
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
g8
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
g8

putMessage :: Message -> Put
putMessage :: Message -> Put
putMessage (NLinkMsg LinkType
ty Word32
idx Word32
flags) = do
    Word8 -> Put
p8 forall a. Num a => a
eAF_UNSPEC forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
p8 Word8
0
    Word16 -> Put
p16 (forall a b. (Integral a, Num b) => a -> b
fromIntegral LinkType
ty)
    Word32 -> Put
p32 Word32
idx
    Word32 -> Put
p32 Word32
flags
    Word32 -> Put
p32 Word32
0xFFFFFFFF
putMessage (NAddrMsg AddressFamily
fam Word8
maskLen Word8
flags Word8
scope Word32
idx) = do
    Word8 -> Put
p8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral AddressFamily
fam)
    Word8 -> Put
p8 Word8
maskLen
    Word8 -> Put
p8 Word8
flags
    Word8 -> Put
p8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
scope)
    Word32 -> Put
p32 Word32
idx
putMessage (NNeighMsg Word8
f Int32
i Word16
s Word8
fl Word8
t) = do
    Word8 -> Put
p8 Word8
f
    Word8 -> Put
p8 Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
p8 Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
p8 Word8
0 --padding
    Word32 -> Put
p32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
    Word16 -> Put
p16 Word16
s
    Word8 -> Put
p8 Word8
fl
    Word8 -> Put
p8 Word8
t

-- |'Get' a route message or an error
getRoutePackets :: ByteString -> Either String [RoutePacket]
getRoutePackets :: ByteString -> Either [Char] [RoutePacket]
getRoutePackets = forall a.
(Convertable a, Eq a, Show a) =>
ByteString -> Either [Char] [Packet a]
getPackets

-- |typedef for utility functions
type AttributeReader a = Attributes -> Maybe a

-- |typedef for utility functions
type AttributeWriter a = a -> Attributes -> Attributes

--
-- Link message attributes
--
type LinkAddress = (Word8, Word8, Word8, Word8, Word8, Word8)

-- |get L2 address from netlink attributes
getLinkAddress :: AttributeReader LinkAddress
getLinkAddress :: AttributeReader LinkAddress
getLinkAddress Attributes
attrs = ByteString -> LinkAddress
decodeMAC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eIFLA_ADDRESS Attributes
attrs

-- |set L2 address on netlink attributes
putLinkAddress :: AttributeWriter LinkAddress
putLinkAddress :: AttributeWriter LinkAddress
putLinkAddress LinkAddress
addr = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert forall a. Num a => a
eIFLA_ADDRESS (LinkAddress -> ByteString
encodeMAC LinkAddress
addr)

-- |get L2 broadcast address from netlink attributes
getLinkBroadcast :: AttributeReader LinkAddress
getLinkBroadcast :: AttributeReader LinkAddress
getLinkBroadcast Attributes
attrs = ByteString -> LinkAddress
decodeMAC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eIFLA_BROADCAST Attributes
attrs

-- |set L2 broadcast address on netlink attributes
putLinkBroadcast :: AttributeWriter LinkAddress
putLinkBroadcast :: AttributeWriter LinkAddress
putLinkBroadcast LinkAddress
addr = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert forall a. Num a => a
eIFLA_BROADCAST (LinkAddress -> ByteString
encodeMAC LinkAddress
addr)

-- |get interface name from netlink attributes
getLinkName :: AttributeReader String
getLinkName :: AttributeReader [Char]
getLinkName Attributes
attrs = ByteString -> [Char]
getString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eIFLA_IFNAME Attributes
attrs

-- |set interface name on netlink attributes
putLinkName :: AttributeWriter String
putLinkName :: AttributeWriter [Char]
putLinkName [Char]
ifname = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert forall a. Num a => a
eIFLA_IFNAME ([Char] -> ByteString
putString [Char]
ifname)

-- |get mtu from netlink attributes
getLinkMTU :: AttributeReader Word32
getLinkMTU :: AttributeReader Word32
getLinkMTU Attributes
attrs = ByteString -> Maybe Word32
get32 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
eIFLA_MTU Attributes
attrs

-- |set mtu on netlink attributes
putLinkMTU :: AttributeWriter Word32
putLinkMTU :: AttributeWriter Word32
putLinkMTU Word32
mtu = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert forall a. Num a => a
eIFLA_MTU (Word32 -> ByteString
put32 Word32
mtu)

-- TODO: IFLA_LINK - need to understand what it does

-- |I actually have no idea what QDisc is
getLinkQDisc :: AttributeReader String
getLinkQDisc :: AttributeReader [Char]
getLinkQDisc Attributes
attrs = ByteString -> [Char]
getString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eIFLA_QDISC Attributes
attrs

-- |I actually have no idea what QDisc is
putLinkQDisc :: AttributeWriter String
putLinkQDisc :: AttributeWriter [Char]
putLinkQDisc [Char]
disc = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert forall a. Num a => a
eIFLA_QDISC ([Char] -> ByteString
putString [Char]
disc)

-- TODO: IFLA_STATS - bloody huge message, will deal with it later.

-- TODO: IFLA_{COST,PRIORITY,MASTER,WIRELESS,PROTINFO} - need to
-- understand what they do.

-- |I should look this up
getLinkTXQLen :: AttributeReader Word32
getLinkTXQLen :: AttributeReader Word32
getLinkTXQLen Attributes
attrs = ByteString -> Maybe Word32
get32 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
eIFLA_TXQLEN Attributes
attrs

-- |I should look this up
putLinkTXQLen :: AttributeWriter Word32
putLinkTXQLen :: AttributeWriter Word32
putLinkTXQLen Word32
len = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert forall a. Num a => a
eIFLA_TXQLEN (Word32 -> ByteString
put32 Word32
len)

-- TODO: IFLA_{MAP,WEIGHT} - need to figure out

-- TODO: IFLA_{LINKMODE,LINKINFO} - see Documentation/networking/operstates.txt

-- TODO: IFLA_{NET_NS_PID,IFALIAS} - need to figure out

-- |get interface address from netlink attributes of 'NAddrMsg'
getIFAddr :: AttributeReader ByteString
getIFAddr :: AttributeReader ByteString
getIFAddr = forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eIFA_ADDRESS

-- |get L2 address from netlink attributes of 'NNeighMsg'
getLLAddr :: AttributeReader LinkAddress
getLLAddr :: AttributeReader LinkAddress
getLLAddr Attributes
attrs = ByteString -> LinkAddress
decodeMAC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eNDA_LLADDR Attributes
attrs

-- |get destination address from netlink attributes of 'NNeighMsg'
getDstAddr :: AttributeReader ByteString
getDstAddr :: AttributeReader ByteString
getDstAddr = forall k a. Ord k => k -> Map k a -> Maybe a
lookup forall a. Num a => a
eNDA_DST

--
-- Helpers
--

decodeMAC :: ByteString -> LinkAddress
decodeMAC :: ByteString -> LinkAddress
decodeMAC = forall {f}. [f] -> (f, f, f, f, f, f)
tuplify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
unpack
  where tuplify :: [f] -> (f, f, f, f, f, f)
tuplify [f
a,f
b,f
c,f
d,f
e,f
f] = (f
a,f
b,f
c,f
d,f
e,f
f)
        tuplify [f]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Bad encoded MAC"

encodeMAC :: LinkAddress -> ByteString
encodeMAC :: LinkAddress -> ByteString
encodeMAC = [Char] -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a, a, a, a, a, a) -> [a]
listify
  where listify :: (a, a, a, a, a, a) -> [a]
listify (a
a,a
b,a
c,a
d,a
e,a
f) = [a
a,a
b,a
c,a
d,a
e,a
f]

getString :: ByteString -> String
getString :: ByteString -> [Char]
getString ByteString
b = ByteString -> [Char]
unpack (HasCallStack => ByteString -> ByteString
init ByteString
b)

putString :: String -> ByteString
putString :: [Char] -> ByteString
putString [Char]
s = ByteString -> ByteString -> ByteString
append ([Char] -> ByteString
pack [Char]
s) ByteString
"\0"

get32 :: ByteString -> Maybe Word32
get32 :: ByteString -> Maybe Word32
get32 ByteString
bs = case forall a. Get a -> ByteString -> Either [Char] a
runGet Get Word32
getWord32host ByteString
bs of
    Left  [Char]
_ -> forall a. Maybe a
Nothing
    Right Word32
w -> forall a. a -> Maybe a
Just Word32
w

put32 :: Word32 -> ByteString
put32 :: Word32 -> ByteString
put32 Word32
w = Put -> ByteString
runPut (Word32 -> Put
putWord32host Word32
w)