{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : Instana.SDK.Internal.AgentConnection.DefaultGatewayIp
Description : Extracts the default gateway IP from the content of /proc/self/net/route.
-}
module Instana.SDK.Internal.AgentConnection.DefaultGatewayIp
    ( extractDefaultGatewayIp
    ) where

import           Control.Monad (join)
import qualified Data.List     as List
import           Data.Text     (Text)
import qualified Data.Text     as T
import           Numeric       (readHex)
import           Safe          (atMay)


-- |Parses the content of /proc/self/net/route to retrieve the IP of the default
-- gateway.
extractDefaultGatewayIp :: String -> Maybe String
extractDefaultGatewayIp :: String -> Maybe String
extractDefaultGatewayIp routeFileContent :: String
routeFileContent =
  let
    allLines :: [String]
allLines = String -> [String]
lines String
routeFileContent
    linesAsFields :: [[Text]]
linesAsFields = (String -> [Text]) -> [String] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (\l :: String
l -> Text -> Text -> [Text]
T.splitOn "\t" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
l) [String]
allLines
    lineWithDefaultGateway :: Maybe [Text]
lineWithDefaultGateway = ([Text] -> Bool) -> [[Text]] -> Maybe [Text]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find [Text] -> Bool
isDefaultGatewayLine [[Text]]
linesAsFields
    ip :: Maybe Text
ip = Maybe (Maybe Text) -> Maybe Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Text) -> Maybe Text)
-> Maybe (Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ([Text] -> Maybe Text) -> Maybe [Text] -> Maybe (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Maybe Text
extractIpFromFields Maybe [Text]
lineWithDefaultGateway
  in
  (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack Maybe Text
ip


isDefaultGatewayLine :: [Text] -> Bool
isDefaultGatewayLine :: [Text] -> Bool
isDefaultGatewayLine fields :: [Text]
fields =
  let
    field2 :: Maybe Text
field2 = [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
atMay [Text]
fields 1
    lenField3 :: Maybe Int
lenField3 = (Text -> Int) -> Maybe Text -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length (Maybe Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
atMay [Text]
fields 2
  in
  [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
fields Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 3 Bool -> Bool -> Bool
&&
    Maybe Text
field2 Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just "00000000" Bool -> Bool -> Bool
&&
    Maybe Int
lenField3 Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just 8


extractIpFromFields :: [Text] -> Maybe Text
extractIpFromFields :: [Text] -> Maybe Text
extractIpFromFields fields :: [Text]
fields =
  (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
convertHexStringToIp (Maybe Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
atMay [Text]
fields 2


convertHexStringToIp :: Text -> Text
convertHexStringToIp :: Text -> Text
convertHexStringToIp hexstring :: Text
hexstring =
  let
    o1 :: Text
o1 = Int -> Text -> Text
substringLength2 6 Text
hexstring
    o2 :: Text
o2 = Int -> Text -> Text
substringLength2 4 Text
hexstring
    o3 :: Text
o3 = Int -> Text -> Text
substringLength2 2 Text
hexstring
    o4 :: Text
o4 = Int -> Text -> Text
T.take 2 Text
hexstring
  in
  Text -> [Text] -> Text
T.intercalate "." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
hexstringToDecimal [Text
o1, Text
o2, Text
o3, Text
o4]


substringLength2 :: Int -> Text -> Text
substringLength2 :: Int -> Text -> Text
substringLength2 start :: Int
start =
  Int -> Text -> Text
T.take 2 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
start


hexstringToDecimal :: Text -> Text
hexstringToDecimal :: Text -> Text
hexstringToDecimal hexstring :: Text
hexstring =
  let
    result :: [(Int, String)]
result = ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
hexstring
  in
  case [(Int, String)]
result of
      (x :: Int
x,_):_ -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int
x :: Int)
      _       -> "0"