{-# LANGUAGE TupleSections
  #-}
{-| System specific routines for determing the MAC address and macros to help
    sort things out at compile time.
 -}


module System.Info.MAC.Fetch where

import Data.MAC

import Control.Monad
import Control.Applicative ((<$>))
import Data.List
import Data.Maybe
import System.Process
import System.Info
import System.IO
import Text.ParserCombinators.Parsec


{-| Obtain a list containing the name and MAC of all NICs.
 -}
fetchNICs                   ::  IO [(String, MAC)]
fetchNICs :: IO [(String, MAC)]
fetchNICs                    =  String -> [(String, MAC)]
parser (String -> [(String, MAC)]) -> IO String -> IO [(String, MAC)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
i_config


{-| Run @ifconfig@ or @ipconfig@, as appropriate, capturing its output.
 -}
i_config                    ::  IO String
i_config :: IO String
i_config                     =  do
  (_, o :: Handle
o, _, h :: ProcessHandle
h)              <-  String -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveCommand String
cmd
  String
outputs                   <-  Handle -> IO String
hGetContents Handle
o
  Int -> IO () -> IO ()
forall a b. a -> b -> b
seq (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
outputs) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
h
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
outputs
 where
  cmd :: String
cmd | String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "mingw32"      =  "ipconfig /all"
      | Bool
otherwise            =  "LANG=C ifconfig"



parser :: String -> [(String, MAC)]
parser | String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "mingw32"     =  String -> Parser [(String, MAC)] -> String -> [(String, MAC)]
forall t. String -> Parser [t] -> String -> [t]
parse' "ipconfig" Parser [(String, MAC)]
ipconfig
       | Bool
otherwise           =  String -> Parser [(String, MAC)] -> String -> [(String, MAC)]
forall t. String -> Parser [t] -> String -> [t]
parse' "ifconfig" Parser [(String, MAC)]
ifconfig (String -> [(String, MAC)])
-> (String -> String) -> String -> [(String, MAC)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++)


{-| Parses the output of Linux or BSD @ifconfig@.
 -}
ifconfig                    ::  Parser [(String, MAC)]
ifconfig :: Parser [(String, MAC)]
ifconfig                     =  Parser (Maybe (String, MAC)) -> Parser [(String, MAC)]
parseNICs Parser (Maybe (String, MAC))
parseNIC_ifconfig


{-| Parses the output of Windows @ipconfig@.
 -}
ipconfig                    ::  Parser [(String, MAC)]
ipconfig :: Parser [(String, MAC)]
ipconfig                     =  Parser (Maybe (String, MAC)) -> Parser [(String, MAC)]
parseNICs Parser (Maybe (String, MAC))
parseNIC_ipconfig


parseNIC_ifconfig           ::  Parser (Maybe (String, MAC))
parseNIC_ifconfig :: Parser (Maybe (String, MAC))
parseNIC_ifconfig            =  do
  String
name                      <-  ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
  ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. Parser a -> Parser b -> Parser b
skipManyTill ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n')) ParsecT String () Identity String
forall u. ParsecT String u Identity String
markers
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ' '
  ((String
name,) (MAC -> (String, MAC)) -> Maybe MAC -> Maybe (String, MAC)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe MAC -> Maybe (String, MAC))
-> ParsecT String () Identity (Maybe MAC)
-> Parser (Maybe (String, MAC))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT String () Identity (Maybe MAC)
forall u. Char -> ParsecT String u Identity (Maybe MAC)
parseMAC ':'
 where
  markers :: ParsecT String u Identity String
markers = [ParsecT String u Identity String]
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT String u Identity String]
 -> ParsecT String u Identity String)
-> [ParsecT String u Identity String]
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ (String -> ParsecT String u Identity String)
-> [String] -> [ParsecT String u Identity String]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT String u Identity String
-> ParsecT String u Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity String
 -> ParsecT String u Identity String)
-> (String -> ParsecT String u Identity String)
-> String
-> ParsecT String u Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string) [ "ether", "HWaddr" ]


parseNIC_ipconfig           ::  Parser (Maybe (String, MAC))
parseNIC_ipconfig :: Parser (Maybe (String, MAC))
parseNIC_ipconfig            =  do
  String
name                      <-  do String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "Ethernet adapter "
                                   ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n')) (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':')
  (ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. Parser a -> Parser a
skipManyAnyTill (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ([ParsecT String () Identity String]
    -> ParsecT String () Identity String)
-> [ParsecT String () Identity String]
-> ParsecT String () Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT String () Identity String]
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice) [ ParsecT String () Identity Char -> ParsecT String () Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
nl ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
nl) ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected "\\r\\n\\r\\n"
                             , (ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> (String -> ParsecT String () Identity String)
-> String
-> ParsecT String () Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string) "Physical Address" ]
  ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n')) (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':')
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ' '
  ((String
name,) (MAC -> (String, MAC)) -> Maybe MAC -> Maybe (String, MAC)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe MAC -> Maybe (String, MAC))
-> ParsecT String () Identity (Maybe MAC)
-> Parser (Maybe (String, MAC))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT String () Identity (Maybe MAC)
forall u. Char -> ParsecT String u Identity (Maybe MAC)
parseMAC '-'


parseNICs :: Parser (Maybe (String, MAC)) -> Parser [(String, MAC)]
parseNICs :: Parser (Maybe (String, MAC)) -> Parser [(String, MAC)]
parseNICs p :: Parser (Maybe (String, MAC))
p                  =  [Maybe (String, MAC)] -> [(String, MAC)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (String, MAC)] -> [(String, MAC)])
-> ParsecT String () Identity [Maybe (String, MAC)]
-> Parser [(String, MAC)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [Maybe (String, MAC)]
parseNICs'
 where
  parseNICs' :: ParsecT String () Identity [Maybe (String, MAC)]
parseNICs'                 =  (ParsecT String () Identity [Maybe (String, MAC)]
-> ParsecT String () Identity [Maybe (String, MAC)]
forall a. Parser a -> Parser a
skipManyAnyTill (ParsecT String () Identity [Maybe (String, MAC)]
 -> ParsecT String () Identity [Maybe (String, MAC)])
-> ([ParsecT String () Identity [Maybe (String, MAC)]]
    -> ParsecT String () Identity [Maybe (String, MAC)])
-> [ParsecT String () Identity [Maybe (String, MAC)]]
-> ParsecT String () Identity [Maybe (String, MAC)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT String () Identity [Maybe (String, MAC)]]
-> ParsecT String () Identity [Maybe (String, MAC)]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice)
                                          [ ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT String () Identity ()
-> ParsecT String () Identity [Maybe (String, MAC)]
-> ParsecT String () Identity [Maybe (String, MAC)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Maybe (String, MAC)]
-> ParsecT String () Identity [Maybe (String, MAC)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                                          , do ParsecT String () Identity Char -> ParsecT String () Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
nl ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
nl)
                                               Maybe (String, MAC)
nic <- Parser (Maybe (String, MAC))
p
                                               (Maybe (String, MAC)
nicMaybe (String, MAC)
-> [Maybe (String, MAC)] -> [Maybe (String, MAC)]
forall a. a -> [a] -> [a]
:) ([Maybe (String, MAC)] -> [Maybe (String, MAC)])
-> ParsecT String () Identity [Maybe (String, MAC)]
-> ParsecT String () Identity [Maybe (String, MAC)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [Maybe (String, MAC)]
parseNICs' ]


parseMAC :: Char -> ParsecT String u Identity (Maybe MAC)
parseMAC sepChar :: Char
sepChar = String -> Maybe MAC
maybeMAC (String -> Maybe MAC)
-> ([String] -> String) -> [String] -> Maybe MAC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ":" ([String] -> Maybe MAC)
-> ParsecT String u Identity [String]
-> ParsecT String u Identity (Maybe MAC)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char
-> ParsecT String u Identity [String]
forall u sep.
ParsecT String u Identity sep -> ParsecT String u Identity [String]
sepHex (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
sepChar)


parse'                      ::  String -> Parser [t] -> String -> [t]
parse' :: String -> Parser [t] -> String -> [t]
parse' source :: String
source parser :: Parser [t]
parser         =  (ParseError -> [t]) -> ([t] -> [t]) -> Either ParseError [t] -> [t]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([t] -> ParseError -> [t]
forall a b. a -> b -> a
const []) [t] -> [t]
forall a. a -> a
id (Either ParseError [t] -> [t])
-> (String -> Either ParseError [t]) -> String -> [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser [t] -> String -> String -> Either ParseError [t]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser [t]
parser String
source


maybeMAC                    ::  String -> Maybe MAC
maybeMAC :: String -> Maybe MAC
maybeMAC s :: String
s =
  case ReadS MAC
forall a. Read a => ReadS a
reads String
s of
    [(mac :: MAC
mac, _)]              ->  MAC -> Maybe MAC
forall a. a -> Maybe a
Just MAC
mac
    _                       ->  Maybe MAC
forall a. Maybe a
Nothing


sepHex :: ParsecT String u Identity sep -> ParsecT String u Identity [String]
sepHex                       =  ParsecT String u Identity String
-> ParsecT String u Identity sep
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepBy ([ParsecT String u Identity Char]
-> ParsecT String u Identity String
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit, ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit])


manyAnyTill                 ::  Parser Char -> Parser String
manyAnyTill :: ParsecT String () Identity Char
-> ParsecT String () Identity String
manyAnyTill                  =  ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar


skipManyTill                ::  Parser a -> Parser b -> Parser b
skipManyTill :: Parser a -> Parser b -> Parser b
skipManyTill p :: Parser a
p end :: Parser b
end           =  [Parser b] -> Parser b
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Parser b -> Parser b
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser b
end, Parser a
p Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a -> Parser b -> Parser b
forall a b. Parser a -> Parser b -> Parser b
skipManyTill Parser a
p Parser b
end]


skipManyAnyTill             ::  Parser a -> Parser a
skipManyAnyTill :: Parser a -> Parser a
skipManyAnyTill              =  ParsecT String () Identity Char -> Parser a -> Parser a
forall a b. Parser a -> Parser b -> Parser b
skipManyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar


nl :: ParsecT String u Identity Char
nl                           =  ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\r') ParsecT String u Identity String
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\n'