{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} module Network.ZRE.Utils ( uuidByteString , exitFail , bshow , getDefRoute , getIface , getIfaceReport , getName , randPort , emit , emitdbg) where import System.Exit import System.Process import System.Random import System.ZMQ4.Endpoint import Network.BSD (getHostName) import Network.Info import Network.ZRE.Types import Control.Concurrent.STM import Control.Exception import Network.Socket hiding (Debug) import Data.UUID (UUID, toByteString) import Data.Maybe import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as BL uuidByteString :: UUID -> B.ByteString uuidByteString :: UUID -> ByteString uuidByteString = ByteString -> ByteString BL.toStrict (ByteString -> ByteString) -> (UUID -> ByteString) -> UUID -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . UUID -> ByteString toByteString exitFail :: B.ByteString -> IO b exitFail :: ByteString -> IO b exitFail msg :: ByteString msg = do ByteString -> IO () B.putStrLn ByteString msg IO b forall a. IO a exitFailure bshow :: (Show a) => a -> B.ByteString bshow :: a -> ByteString bshow = String -> ByteString B.pack (String -> ByteString) -> (a -> String) -> a -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> String forall a. Show a => a -> String show getDefRoute :: IO (Maybe (B.ByteString, B.ByteString)) getDefRoute :: IO (Maybe (ByteString, ByteString)) getDefRoute = do [String] ipr <- (String -> [String]) -> IO String -> IO [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap String -> [String] lines (IO String -> IO [String]) -> IO String -> IO [String] forall a b. (a -> b) -> a -> b $ String -> [String] -> String -> IO String readProcess "ip" ["route"] [] Maybe (ByteString, ByteString) -> IO (Maybe (ByteString, ByteString)) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe (ByteString, ByteString) -> IO (Maybe (ByteString, ByteString))) -> Maybe (ByteString, ByteString) -> IO (Maybe (ByteString, ByteString)) forall a b. (a -> b) -> a -> b $ [(ByteString, ByteString)] -> Maybe (ByteString, ByteString) forall a. [a] -> Maybe a listToMaybe ([(ByteString, ByteString)] -> Maybe (ByteString, ByteString)) -> [(ByteString, ByteString)] -> Maybe (ByteString, ByteString) forall a b. (a -> b) -> a -> b $ [Maybe (ByteString, ByteString)] -> [(ByteString, ByteString)] forall a. [Maybe a] -> [a] catMaybes ([Maybe (ByteString, ByteString)] -> [(ByteString, ByteString)]) -> [Maybe (ByteString, ByteString)] -> [(ByteString, ByteString)] forall a b. (a -> b) -> a -> b $ ([String] -> Maybe (ByteString, ByteString)) -> [[String]] -> [Maybe (ByteString, ByteString)] forall a b. (a -> b) -> [a] -> [b] map [String] -> Maybe (ByteString, ByteString) getDef ((String -> [String]) -> [String] -> [[String]] forall a b. (a -> b) -> [a] -> [b] map String -> [String] words [String] ipr) where getDef :: [String] -> Maybe (ByteString, ByteString) getDef ("default":"via":gw :: String gw:"dev":dev :: String dev:_) = (ByteString, ByteString) -> Maybe (ByteString, ByteString) forall a. a -> Maybe a Just (String -> ByteString B.pack String gw, String -> ByteString B.pack String dev) getDef _ = Maybe (ByteString, ByteString) forall a. Maybe a Nothing getIface :: B.ByteString -> IO (Maybe NetworkInterface) getIface :: ByteString -> IO (Maybe NetworkInterface) getIface iname :: ByteString iname = do [NetworkInterface] ns <- IO [NetworkInterface] getNetworkInterfaces Maybe NetworkInterface -> IO (Maybe NetworkInterface) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe NetworkInterface -> IO (Maybe NetworkInterface)) -> Maybe NetworkInterface -> IO (Maybe NetworkInterface) forall a b. (a -> b) -> a -> b $ [NetworkInterface] -> Maybe NetworkInterface forall a. [a] -> Maybe a listToMaybe ([NetworkInterface] -> Maybe NetworkInterface) -> [NetworkInterface] -> Maybe NetworkInterface forall a b. (a -> b) -> a -> b $ (NetworkInterface -> Bool) -> [NetworkInterface] -> [NetworkInterface] forall a. (a -> Bool) -> [a] -> [a] filter (\x :: NetworkInterface x -> NetworkInterface -> String name NetworkInterface x String -> String -> Bool forall a. Eq a => a -> a -> Bool == ByteString -> String B.unpack ByteString iname) [NetworkInterface] ns getIfaceReport :: B.ByteString -> IO (B.ByteString, B.ByteString, B.ByteString) getIfaceReport :: ByteString -> IO (ByteString, ByteString, ByteString) getIfaceReport iname :: ByteString iname = do Maybe NetworkInterface i <- ByteString -> IO (Maybe NetworkInterface) getIface ByteString iname case Maybe NetworkInterface i of Nothing -> ByteString -> IO (ByteString, ByteString, ByteString) forall b. ByteString -> IO b exitFail (ByteString -> IO (ByteString, ByteString, ByteString)) -> ByteString -> IO (ByteString, ByteString, ByteString) forall a b. (a -> b) -> a -> b $ "Unable to get info for interace " ByteString -> ByteString -> ByteString `B.append` ByteString iname (Just NetworkInterface{..}) -> (ByteString, ByteString, ByteString) -> IO (ByteString, ByteString, ByteString) forall (m :: * -> *) a. Monad m => a -> m a return (ByteString iname, String -> ByteString B.pack (String -> ByteString) -> String -> ByteString forall a b. (a -> b) -> a -> b $ IPv4 -> String forall a. Show a => a -> String show IPv4 ipv4, String -> ByteString B.pack (String -> ByteString) -> String -> ByteString forall a b. (a -> b) -> a -> b $ IPv6 -> String forall a. Show a => a -> String show IPv6 ipv6) getName :: B.ByteString -> IO B.ByteString getName :: ByteString -> IO ByteString getName "" = (String -> ByteString) -> IO String -> IO ByteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap String -> ByteString B.pack IO String getHostName getName x :: ByteString x = ByteString -> IO ByteString forall (m :: * -> *) a. Monad m => a -> m a return ByteString x randPort :: B.ByteString -> IO Port randPort :: ByteString -> IO Port randPort ip :: ByteString ip = Port -> IO Port forall b a. (Random b, Show b, Ord a, Num b, Num a) => a -> IO b loop (100 :: Int) where loop :: a -> IO b loop cnt :: a cnt = do b port <- (b, b) -> IO b forall a. Random a => (a, a) -> IO a randomRIO (41000, 41100) (xAddr :: AddrInfo xAddr:_) <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo] getAddrInfo Maybe AddrInfo forall a. Maybe a Nothing (String -> Maybe String forall a. a -> Maybe a Just (String -> Maybe String) -> String -> Maybe String forall a b. (a -> b) -> a -> b $ ByteString -> String B.unpack ByteString ip) (String -> Maybe String forall a. a -> Maybe a Just (String -> Maybe String) -> String -> Maybe String forall a b. (a -> b) -> a -> b $ b -> String forall a. Show a => a -> String show b port) Either IOException Socket esocket <- IO Socket -> IO (Either IOException Socket) forall e a. Exception e => IO a -> IO (Either e a) try (IO Socket -> IO (Either IOException Socket)) -> IO Socket -> IO (Either IOException Socket) forall a b. (a -> b) -> a -> b $ AddrInfo -> IO Socket getSocket AddrInfo xAddr case Either IOException Socket esocket :: Either IOException Socket of Left e :: IOException e | a cnt a -> a -> Bool forall a. Ord a => a -> a -> Bool <= 1 -> String -> IO b forall a. HasCallStack => String -> a error (String -> IO b) -> String -> IO b forall a b. (a -> b) -> a -> b $ [String] -> String forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ "Unable to bind to random port, last tried was " , b -> String forall a. Show a => a -> String show b port , ". Exception was: " , IOException -> String forall a. Show a => a -> String show IOException e ] | Bool otherwise -> do a -> IO b loop (a -> IO b) -> a -> IO b forall a b. (a -> b) -> a -> b $! a cnt a -> a -> a forall a. Num a => a -> a -> a - 1 Right s :: Socket s -> do Socket -> IO () close Socket s b -> IO b forall (m :: * -> *) a. Monad m => a -> m a return b port getSocket :: AddrInfo -> IO Socket getSocket addr :: AddrInfo addr = do Socket s <- Family -> SocketType -> ProtocolNumber -> IO Socket socket (AddrInfo -> Family addrFamily AddrInfo addr) SocketType Stream ProtocolNumber defaultProtocol Socket -> SockAddr -> IO () bind Socket s (AddrInfo -> SockAddr addrAddress AddrInfo addr) Socket -> IO Socket forall (m :: * -> *) a. Monad m => a -> m a return Socket s emit :: TVar ZREState -> Event -> STM () emit :: TVar ZREState -> Event -> STM () emit s :: TVar ZREState s x :: Event x = do ZREState st <- TVar ZREState -> STM ZREState forall a. TVar a -> STM a readTVar TVar ZREState s TBQueue Event -> Event -> STM () forall a. TBQueue a -> a -> STM () writeTBQueue (ZREState -> TBQueue Event zreIn ZREState st) Event x emitdbg :: TVar ZREState -> B.ByteString -> STM () emitdbg :: TVar ZREState -> ByteString -> STM () emitdbg s :: TVar ZREState s x :: ByteString x = do ZREState st <- TVar ZREState -> STM ZREState forall a. TVar a -> STM a readTVar TVar ZREState s case ZREState -> Bool zreDebug ZREState st of True -> TBQueue Event -> Event -> STM () forall a. TBQueue a -> a -> STM () writeTBQueue (ZREState -> TBQueue Event zreIn ZREState st) (Event -> STM ()) -> Event -> STM () forall a b. (a -> b) -> a -> b $ ByteString -> Event Debug ByteString x _ -> () -> STM () forall (m :: * -> *) a. Monad m => a -> m a return ()