diff --git a/CONTRIBUTORS b/CONTRIBUTORS --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -1,2 +1,5 @@ Jason Dusek + Martin Grabmueller + Joachim Breitner + Nathan Howell diff --git a/Data/MAC.hs b/Data/MAC.hs --- a/Data/MAC.hs +++ b/Data/MAC.hs @@ -1,11 +1,9 @@ {-| A MAC address datatype, representing the six bytes of a MAC address, also - - known as an OID, IAB or "...Vendor Address, Vendor ID, NIC Address, - - Ethernet Address and others.". - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} + known as an OID, IAB or \"...Vendor Address, Vendor ID, NIC Address, + Ethernet Address and others.\", see + + -} module Data.MAC where diff --git a/MACCatcher.hs b/MACCatcher.hs --- a/MACCatcher.hs +++ b/MACCatcher.hs @@ -1,11 +1,9 @@ #!/usr/bin/env runhaskell - -- Catch your MAC Address! import System.Info.MAC main = do - mac <- mac - case mac of - Just mac -> print mac - Nothing -> putStrLn "Failed to obtain MAC address." + macs <- macs + case macs of _:_ -> mapM_ print macs + [ ] -> putStrLn "Failed to obtain MAC address." diff --git a/System/Info/MAC.hs b/System/Info/MAC.hs --- a/System/Info/MAC.hs +++ b/System/Info/MAC.hs @@ -2,12 +2,15 @@ {-| Obtain a MAC address for the host system, on *NIX and Windows. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} + -} module System.Info.MAC - ( new - , mac + ( mac + , macs + , nic + , nics + , refresh ) where import Data.MAC @@ -16,28 +19,47 @@ import Data.IORef import System.IO import System.IO.Unsafe +import Data.Maybe +import Control.Applicative -{-| Explicitly re-run the MAC catching operation. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} -new :: IO (Maybe MAC) -new = fetch +{-| Fetch MAC address, using a cached value if it is available. + -} +mac :: IO (Maybe MAC) +mac = listToMaybe <$> macs -{-| Return a host MAC address, using a cached value if it is available. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} -mac :: IO (Maybe MAC) -mac = do +{-| Fetch MAC addresses, using a cached value if it is available. + -} +macs :: IO [MAC] +macs = map snd <$> nics + + +{-| Fetch a name-MAC pair, using a cached value if it is available. + -} +nic :: IO (Maybe (String, MAC)) +nic = listToMaybe <$> nics + + +{-| Fetch name-MAC pairs, using a cached value if it is available. + -} +nics :: IO [(String, MAC)] +nics = do val <- readIORef fetched - case val of - Nothing -> do - res <- new - writeIORef fetched res - return res - _ -> return val + case val of [ ] -> refresh + _:_ -> return val +{-| Explicitly re-run the MAC reading operation. + -} +refresh :: IO [(String, MAC)] +refresh = do + res <- fetchNICs + writeIORef fetched res + return res + + {-# NOINLINE fetched #-} -fetched = unsafePerformIO $ newIORef Nothing +fetched = unsafePerformIO $ newIORef [] diff --git a/System/Info/MAC/Fetch.hs b/System/Info/MAC/Fetch.hs --- a/System/Info/MAC/Fetch.hs +++ b/System/Info/MAC/Fetch.hs @@ -1,8 +1,8 @@ - - +{-# LANGUAGE TupleSections + #-} {-| System specific routines for determing the MAC address and macros to help - - sort things out at compile time. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} + sort things out at compile time. + -} module System.Info.MAC.Fetch where @@ -10,82 +10,90 @@ 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 the appropriate hardware MAC fetcher for the host operating system. - - This could be inlined, but in practice it is run only once. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} -fetch = - case os of -- This feels like it should be in IO. - "mingw32" -> win32 - _ -> nixen - - -{-| Obtain the hardware address on @*NIX@ of any kind, using a command line - - utility. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} -nixen :: IO (Maybe MAC) -nixen = do - (_, o, _, h) <- runInteractiveCommand "ifconfig" - waitForProcess h - outputs <- hGetContents o - return $ join $ ifconfig outputs +{-| Obtain a list containing the name and MAC of all NICs. + -} +fetchNICs :: IO [(String, MAC)] +fetchNICs = parser <$> i_config - -- TODO Test this thing. -{-| Obtain the hardware address on Windows, using a command line utility. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} -win32 :: IO (Maybe MAC) -win32 = do - (_, o, _, h) <- runInteractiveCommand "ipconfig /all" +{-| Run @ifconfig@ or @ipconfig@, as appropriate, capturing its output. + -} +i_config :: IO String +i_config = do + (_, o, _, h) <- runInteractiveCommand cmd outputs <- hGetContents o seq (length outputs) (return ()) waitForProcess h - return $ join $ ipconfig outputs + return outputs where - -- Maybe we don't need this? - locations = map (++ "\\ipconfig") - [ "c:\\windows\\system32" - , "c:\\winnt\\system32" - ] + cmd | os == "mingw32" = "ipconfig /all" + | otherwise = "LANG=C ifconfig" -{-| Parses the output of Windows @ipconfig@, yielding a Maybe MAC on - - succesful parse. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} -ipconfig = parse' "ipconfig" $ do - manyTill anyChar $ try $ string "Physical Address" - manyTill anyChar $ char ':' - spaces - hexen <- sepHex '-' - return . maybeMAC . intercalate ":" $ hexen +parser | os == "mingw32" = parse' "ipconfig" ipconfig + | otherwise = parse' "ifconfig" ifconfig . ("\n\n" ++) -{-| Parses the output of Linux or BSD @ifconfig@, yielding a Maybe MAC on - - succesful parse. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} -ifconfig = parse' "ifconfig" $ do - manyTill anyChar markers - spaces - hexen <- sepHex ':' - return . maybeMAC . intercalate ":" $ hexen + +{-| Parses the output of Linux or BSD @ifconfig@. + -} +ifconfig :: Parser [(String, MAC)] +ifconfig = parseNICs parseNIC_ifconfig + + +{-| Parses the output of Windows @ipconfig@. + -} +ipconfig :: Parser [(String, MAC)] +ipconfig = parseNICs parseNIC_ipconfig + + +parseNIC_ifconfig :: Parser (Maybe (String, MAC)) +parseNIC_ifconfig = do + name <- many1 alphaNum + skipManyTill (satisfy (/= '\n')) markers + char ' ' + ((name,) <$>) <$> parseMAC ':' where markers = choice $ map (try . string) [ "ether", "HWaddr" ] +parseNIC_ipconfig :: Parser (Maybe (String, MAC)) +parseNIC_ipconfig = do + name <- do string "Ethernet adapter " + manyTill (satisfy (/= '\n')) (char ':') + (skipManyAnyTill . choice) [ try (nl >> nl) >> unexpected "\\r\\n\\r\\n" + , (try . string) "Physical Address" ] + manyTill (satisfy (/= '\n')) (char ':') + char ' ' + ((name,) <$>) <$> parseMAC '-' -parse' source parser = eitherToMaybe . parse parser source +parseNICs :: Parser (Maybe (String, MAC)) -> Parser [(String, MAC)] +parseNICs p = catMaybes <$> parseNICs' where - eitherToMaybe (Left _) = Nothing - eitherToMaybe (Right r) = Just r + parseNICs' = (skipManyAnyTill . choice) + [ eof >> return [] + , do try (nl >> nl) + nic <- p + (nic:) <$> parseNICs' ] +parseMAC sepChar = maybeMAC . intercalate ":" <$> sepHex (char sepChar) + + +parse' :: String -> Parser [t] -> String -> [t] +parse' source parser = either (const []) id . parse parser source + + maybeMAC :: String -> Maybe MAC maybeMAC s = case reads s of @@ -93,6 +101,21 @@ _ -> Nothing -sepHex = sepBy (sequence [hexDigit, hexDigit]) . char +sepHex = sepBy (sequence [hexDigit, hexDigit]) + + +manyAnyTill :: Parser Char -> Parser String +manyAnyTill = manyTill anyChar + + +skipManyTill :: Parser a -> Parser b -> Parser b +skipManyTill p end = choice [try end, p >> skipManyTill p end] + + +skipManyAnyTill :: Parser a -> Parser a +skipManyAnyTill = skipManyTill anyChar + + +nl = many (char '\r') >> char '\n' diff --git a/maccatcher.cabal b/maccatcher.cabal --- a/maccatcher.cabal +++ b/maccatcher.cabal @@ -1,5 +1,5 @@ name: maccatcher -version: 1.0.1 +version: 2.1.5 category: Text license: BSD3 license-file: LICENSE @@ -9,21 +9,24 @@ description: Obtain the host MAC address on *NIX and Windows. - -cabal-version: >= 1.2 +cabal-version: >= 1.6 build-type: Simple extra-source-files: README , CONTRIBUTORS , samples +source-repository head + type: git + location: http://github.com/solidsnack/maccatcher.git + flag split-base +flag cli + description: Enable command line tool. + default: False + library - if flag(split-base) - build-depends: base >= 4 && < 5 - else - build-depends: base < 4 - build-depends: haskell98 + build-depends: base >= 3 && < 5 , binary , process , parsec @@ -34,4 +37,8 @@ executable maccatcher main-is: MACCatcher.hs + if flag(cli) + buildable: True + else + buildable: False