{-# 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 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
  (Handle
_, Handle
o, Handle
_, ProcessHandle
h)              <-  String -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveCommand String
cmd
  String
outputs                   <-  Handle -> IO String
hGetContents Handle
o
  seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
outputs) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
  ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
h
  forall (m :: * -> *) a. Monad m => a -> m a
return String
outputs
 where
  cmd :: String
cmd | String
os forall a. Eq a => a -> a -> Bool
== String
"mingw32"      =  String
"ipconfig /all"
      | Bool
otherwise            =  String
"LANG=C ifconfig"



parser :: String -> [(String, MAC)]
parser | String
os forall a. Eq a => a -> a -> Bool
== String
"mingw32"     =  forall t. String -> Parser [t] -> String -> [t]
parse' String
"ipconfig" Parser [(String, MAC)]
ipconfig
       | Bool
otherwise           =  forall t. String -> Parser [t] -> String -> [t]
parse' String
"ifconfig" Parser [(String, MAC)]
ifconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"\n\n" 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                      <-  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
  forall a b. Parser a -> Parser b -> Parser b
skipManyTill (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/= Char
'\n')) forall {u}. ParsecT String u Identity String
markers
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
  ((String
name,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. Char -> ParsecT String u Identity (Maybe MAC)
parseMAC Char
':'
 where
  markers :: ParsecT String u Identity String
markers = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string) [ String
"ether", String
"HWaddr" ]


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


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


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


parse'                      ::  String -> Parser [t] -> String -> [t]
parse' :: forall t. String -> Parser [t] -> String -> [t]
parse' String
source Parser [t]
parser         =  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 String
s =
  case forall a. Read a => ReadS a
reads String
s of
    [(MAC
mac, String
_)]              ->  forall a. a -> Maybe a
Just MAC
mac
    [(MAC, String)]
_                       ->  forall a. Maybe a
Nothing


sepHex :: ParsecT String u Identity sep -> ParsecT String u Identity [String]
sepHex                       =  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 (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit, 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                  =  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 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar


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


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


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