{-# LANGUAGE TupleSections
#-}
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
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
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
Int -> IO () -> IO ()
forall a b. a -> b -> b
seq (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
outputs) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
h
String -> IO String
forall a. a -> IO a
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
== String
"mingw32" = String
"ipconfig /all"
| Bool
otherwise = String
"LANG=C ifconfig"
parser :: String -> [(String, MAC)]
parser | String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32" = String -> Parser [(String, MAC)] -> String -> [(String, MAC)]
forall t. String -> Parser [t] -> String -> [t]
parse' String
"ipconfig" Parser [(String, MAC)]
ipconfig
| Bool
otherwise = String -> Parser [(String, MAC)] -> String -> [(String, MAC)]
forall t. String -> Parser [t] -> String -> [t]
parse' String
"ifconfig" Parser [(String, MAC)]
ifconfig (String -> [(String, MAC)])
-> (String -> String) -> String -> [(String, MAC)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++)
ifconfig :: Parser [(String, MAC)]
ifconfig :: Parser [(String, MAC)]
ifconfig = Parser (Maybe (String, MAC)) -> Parser [(String, MAC)]
parseNICs Parser (Maybe (String, MAC))
parseNIC_ifconfig
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
/= Char
'\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 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 Char
':'
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) [ String
"ether", String
"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 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
/= Char
'\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 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 a b. Parser a -> Parser b -> Parser b
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 a b. Parser a -> Parser b -> Parser b
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 String
"\\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) 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
/= Char
'\n')) (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
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 Char
'-'
parseNICs :: Parser (Maybe (String, MAC)) -> Parser [(String, MAC)]
parseNICs :: Parser (Maybe (String, MAC)) -> Parser [(String, MAC)]
parseNICs 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 a b. Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Maybe (String, MAC)]
-> ParsecT String () Identity [Maybe (String, MAC)]
forall a. a -> ParsecT String () Identity a
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 a b. Parser a -> Parser b -> Parser b
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 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
":" ([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' :: forall t. String -> Parser [t] -> String -> [t]
parse' String
source 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 String
s =
case ReadS MAC
forall a. Read a => ReadS a
reads String
s of
[(MAC
mac, String
_)] -> MAC -> Maybe MAC
forall a. a -> Maybe a
Just MAC
mac
[(MAC, String)]
_ -> 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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 :: forall a b. Parser a -> Parser b -> Parser b
skipManyTill Parser a
p 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 a b. 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 :: forall a. 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 Char
'\r') ParsecT String u Identity String
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
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 Char
'\n'