maccatcher 1.0.1 → 2.1.5
raw patch · 6 files changed
Files
- CONTRIBUTORS +3/−0
- Data/MAC.hs +4/−6
- MACCatcher.hs +3/−5
- System/Info/MAC.hs +40/−18
- System/Info/MAC/Fetch.hs +78/−55
- maccatcher.cabal +15/−8
CONTRIBUTORS view
@@ -1,2 +1,5 @@ Jason Dusek+ Martin Grabmueller+ Joachim Breitner+ Nathan Howell
Data/MAC.hs view
@@ -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.".- -- -- - <http://standards.ieee.org/faqs/OUI.html#q4>- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}+ known as an OID, IAB or \"...Vendor Address, Vendor ID, NIC Address,+ Ethernet Address and others.\", see+ <http://standards.ieee.org/faqs/OUI.html#q4>+ -} module Data.MAC where
MACCatcher.hs view
@@ -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."
System/Info/MAC.hs view
@@ -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 []
System/Info/MAC/Fetch.hs view
@@ -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'
maccatcher.cabal view
@@ -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