dhcp-lease-parser (empty) → 0.1

raw patch · 6 files changed

+383/−0 lines, 6 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, chronos, dhcp-lease-parser, ip, tasty, tasty-hunit, text

Files

LICENSE +30/−0
README.md +1/−0
Setup.hs +2/−0
dhcp-lease-parser.cabal +45/−0
src/Dhcp/Lease.hs +224/−0
test/Spec.hs +81/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Andrew Martin (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Martin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,1 @@+# dhcp-lease-parser

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ dhcp-lease-parser.cabal view

@@ -0,0 +1,45 @@+name: dhcp-lease-parser+version: 0.1+homepage: https://github.com/andrewthad/dhcp-lease-parser#readme+license: BSD3+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2017 Andrew Martin+category: software+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10+synopsis: Parse a DHCP lease file++library+  hs-source-dirs: src+  exposed-modules:+    Dhcp.Lease+  build-depends:+      base >= 4.7 && < 5+    , attoparsec >= 0.13 && < 0.14+    , text >= 1.2 && < 1.3+    , bytestring >= 0.10 && < 0.11+    , chronos >= 0.4 && < 0.5+    , ip >= 0.9 && < 0.10+  default-language: Haskell2010++test-suite dhcp-lease-parser-test+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  build-depends:+      base+    , tasty+    , tasty-hunit+    , attoparsec+    , dhcp-lease-parser+    , bytestring+    , chronos+    , ip+  default-language: Haskell2010++source-repository head+  type:     git+  location: https://github.com/andrewthad/dhcp-lease-parser

+ src/Dhcp/Lease.hs view

@@ -0,0 +1,224 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+module Dhcp.Lease+  ( Lease(..)+  , Value(..)+  , Hardware(..)+  , BindingState(..)+  , parserLease+  , parserLeases+  , decodeLeases+  ) where++import qualified Data.Attoparsec.ByteString.Char8 as AB+import qualified Data.Attoparsec.ByteString as ABB+import qualified Data.Attoparsec.ByteString.Lazy as ALB+import qualified Net.IPv4.ByteString.Char8 as IP+import qualified Net.Mac.ByteString.Char8 as Mac+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Char8 as BC+import Data.Char (ord,chr)+import Data.Text.Encoding (decodeUtf8')+import Control.Applicative+import Control.Monad+import Data.Functor+import Data.ByteString (ByteString)+import Data.Text (Text)+import Net.Types+import Chronos.Datetime.ByteString.Char7 (parser_YmdHMS)+import Chronos.Posix (fromDatetime)+import Chronos.Types++data Lease = Lease +  { leaseIp :: !IPv4+  , leaseValues :: ![Value]+  } deriving (Show,Read)++data Value +  = ValueStarts !PosixTime+  | ValueEnds !PosixTime+  | ValueTstp !PosixTime+  | ValueAtsfp !PosixTime+  | ValueCltt !PosixTime+  | ValueBindingState !BindingState+  | ValueNextBindingState !BindingState+  | ValueHardware !Hardware+  | ValueUid !ByteString+  | ValueClientHostname !Text+  deriving (Eq,Ord,Show,Read)++data NextValue = NextValuePresent !Value | NextValueAbsent+data NextName = NextNamePresent !Name | NextNameAbsent++data Name+  = NameStarts+  | NameEnds+  | NameTstp+  | NameAtsfp+  | NameCltt+  | NameBindingState+  | NameNextBindingState+  | NameHardware+  | NameUid+  | NameClientHostname++data BindingState = BindingStateFree | BindingStateActive+  deriving (Eq,Ord,Show,Read)+data Hardware = Hardware+  { hardwareType :: !Text+  , hardwareMac :: !Mac+  } deriving (Eq,Ord,Show,Read)++decodeLeases :: LB.ByteString -> Maybe [Lease]+decodeLeases = ALB.maybeResult . ALB.parse (parserLeases <* AB.endOfInput)++-- | Parse as many leases as possible. Also,+--   strip comments at the start of the input and between+--   leases.+parserLeases :: AB.Parser [Lease]+parserLeases = go id+  where+  go :: ([Lease] -> [Lease]) -> AB.Parser [Lease]+  go diffList = do+    m <- AB.peekChar+    case m of+      Nothing -> return (diffList [])+      Just c -> if c == '#'+        then comment >> go diffList+        else do+          lease <- parserLease+          go ((lease :) . diffList)++comment :: AB.Parser ()+comment = do+  _ <- AB.takeTill (== '\n')+  AB.skipSpace++parserLease :: AB.Parser Lease+parserLease = do+  _ <- AB.string "lease"+  AB.skipSpace+  ip <- IP.parser+  AB.skipSpace+  _ <- AB.char '{'+  AB.skipSpace+  let go vs = do+        nv <- parserValue+        case nv of+          NextValueAbsent -> return vs+          NextValuePresent v -> go (v : vs)+  vals <- go []+  return (Lease ip vals)++parserValue :: AB.Parser NextValue+parserValue = do+  nname <- (AB.string "starts" $> NextNamePresent NameStarts)+    <|> (AB.string "ends" $> NextNamePresent NameEnds)+    <|> (AB.string "tstp" $> NextNamePresent NameTstp)+    <|> (AB.string "atsfp" $> NextNamePresent NameAtsfp)+    <|> (AB.string "cltt" $> NextNamePresent NameCltt)+    <|> (AB.string "binding state" $> NextNamePresent NameBindingState)+    <|> (AB.string "next binding state" $> NextNamePresent NameNextBindingState)+    <|> (AB.string "hardware" $> NextNamePresent NameHardware)+    <|> (AB.string "uid" $> NextNamePresent NameUid)+    <|> (AB.string "client-hostname" $> NextNamePresent NameClientHostname)+    <|> (AB.char '}' $> NextNameAbsent)+  case nname of+    NextNameAbsent -> do+      AB.skipSpace+      return NextValueAbsent+    NextNamePresent name -> do+      AB.skipSpace+      value <- case name of+        NameStarts -> ValueStarts <$> parserTime+        NameEnds -> ValueEnds <$> parserTime+        NameTstp -> ValueTstp <$> parserTime+        NameAtsfp -> ValueAtsfp <$> parserTime+        NameCltt -> ValueCltt <$> parserTime+        NameBindingState -> ValueBindingState <$> parserBindingState+        NameNextBindingState -> ValueNextBindingState <$> parserBindingState+        NameHardware -> ValueHardware <$> parserHardware+        NameUid -> ValueUid <$> parserUid+        NameClientHostname -> ValueClientHostname <$> parserClientHostname+      AB.skipSpace+      _ <- AB.char ';'+      AB.skipSpace+      return (NextValuePresent value)++-- | This doesn't actually work yet. It doesn't espace octal codes.+parserUid :: AB.Parser ByteString+parserUid = do+  isMac <- (AB.char '"' $> False ) <|> pure True+  if isMac+    then AB.takeTill (\x -> not (x == ':' || (x >= '0' && x <= '9') || (x >= 'a' && x <= 'f') || (x >= 'A' && x <= 'F')))+    else do+      let go !cs = do+            n <- possiblyOctal+            case n of+              NextCharDone -> return cs+              NextCharAgain c -> go (c : cs)+      chars <- go []+      return (B.reverse (BC.pack chars))++octalErrorMessage :: String+octalErrorMessage = "invalid octal escape sequence while parsing uid"++c2i :: Char -> Int+c2i = ord++possiblyOctal :: AB.Parser NextChar+possiblyOctal = do+  c <- AB.anyChar+  case c of+    '"' -> return NextCharDone+    '\\' -> do+      c1 <- AB.anyChar+      let i1 = c2i c1 - 48+      when (i1 < 0 || i1 > 3) $ fail octalErrorMessage+      c2 <- AB.anyChar+      let i2 = c2i c2 - 48+      when (i2 < 0 || i2 > 7) $ fail octalErrorMessage+      c3 <- AB.anyChar+      let i3 = c2i c3 - 48+      when (i3 < 0 || i3 > 7) $ fail octalErrorMessage+      return (NextCharAgain (chr (i1 * 64 + i2 * 8 + i3)))+    _ -> return (NextCharAgain c)++data NextChar = NextCharAgain {-# UNPACK #-} !Char | NextCharDone++parserClientHostname :: AB.Parser Text+parserClientHostname = do+  _ <- AB.char '"'+  bs <- AB.takeTill (== '"')+  _ <- AB.anyChar+  case decodeUtf8' bs of+    Left _ -> fail "client hostname name not UTF-8"+    Right name -> return name++parserHardware :: AB.Parser Hardware+parserHardware = Hardware+  <$> (do+        bs <- AB.takeWhile1 (/= ' ')+        case decodeUtf8' bs of+          Left _ -> fail "hardware name not UTF-8"+          Right name -> return name+      ) +  <*  AB.anyChar+  <*> Mac.parserWith (MacCodec (MacGroupingPairs ':') False)++parserBindingState :: AB.Parser BindingState+parserBindingState =+      (AB.string "active" $> BindingStateActive)+  <|> (AB.string "free" $> BindingStateFree)++parserTime :: AB.Parser PosixTime+parserTime = do+  _ <- AB.decimal :: AB.Parser Int+  AB.skipSpace+  dt <- parser_YmdHMS (DatetimeFormat (Just '/') (Just ' ') (Just ':'))+  return (fromDatetime dt)+  +++

+ test/Spec.hs view

@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Tasty+import Test.Tasty.HUnit+import Dhcp.Lease+import Data.Monoid++import qualified Data.List as L+import qualified Data.ByteString as B+import qualified Net.IPv4 as IPv4+import qualified Net.Mac as Mac+import qualified Chronos.Datetime as DT+import qualified Chronos.Posix as PX+import qualified Data.Attoparsec.ByteString as AB++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests]++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [ testCase "000" $ oneLease "sample/000.txt" $ Lease+      (IPv4.fromOctets 10 160 23 253)+      [ ValueStarts $ PX.fromDatetime $ DT.fromYmdhms 2016 1 11 18 31 21+      , ValueEnds $ PX.fromDatetime $ DT.fromYmdhms 2016 02 08 18 38 1+      , ValueTstp $ PX.fromDatetime $ DT.fromYmdhms 2016 02 08 18 38 1+      , ValueBindingState BindingStateFree+      , ValueHardware $ Hardware "ethernet" $ Mac.fromOctets 0x00 0x02 0x80 0x05 0x3E 0x9A+      ]+  , testCase "001" $ oneLease "sample/001.txt" $ Lease+      (IPv4.fromOctets 10 152 33 140)+      [ ValueStarts $ PX.fromDatetime $ DT.fromYmdhms 2017 5 18 14 05 18+      , ValueEnds $ PX.fromDatetime $ DT.fromYmdhms 2017 06 15 14 11 58+      , ValueBindingState BindingStateActive+      , ValueNextBindingState BindingStateFree+      , ValueHardware $ Hardware "ethernet" $ Mac.fromOctets 0x00 0x02 0x80 0x04 0x30 0x63+      , ValueUid $ "\o001\o000\o002\o200\o004" <> "0c"+      , ValueClientHostname "000280043063"+      ]+  , testCase "002" $ oneLease "sample/002.txt" $ Lease+      (IPv4.fromOctets 10 102 18 226)+      [ ValueStarts $ PX.fromDatetime $ DT.fromYmdhms 2017 5 18 5 40 43+      , ValueEnds $ PX.fromDatetime $ DT.fromYmdhms 2017 05 19 0 40 43+      , ValueBindingState BindingStateActive+      , ValueNextBindingState BindingStateFree+      , ValueHardware $ Hardware "ethernet" $ Mac.fromOctets 0x00 0x02 0xA1 0x23 0x03 0x80+      , ValueUid "\o001\o000\o002\o241#\o003\o200"+      ]+  , testCase "003" $ manyLeases "sample/003.txt" 3+  ]++oneLease :: String -> Lease -> Assertion+oneLease filename expected = do+  bs <- B.readFile filename+  case AB.parseOnly (parserLease <* AB.endOfInput) bs of+    Left err -> fail ("parse failed with: " ++ err)+    Right actual -> assertEqual "Lease Equality" (LeaseWrap expected) (LeaseWrap actual)++manyLeases ::+     String -- ^ Filename+  -> Int -- ^ expected number of leases+  -> Assertion+manyLeases filename expectedLen = do+  bs <- B.readFile filename+  case AB.parseOnly (parserLeases <* AB.endOfInput) bs of+    Left err -> fail ("parse failed with: " ++ err)+    Right actual -> assertEqual "Lease List Length Equality"+      expectedLen (L.length actual)++newtype LeaseWrap = LeaseWrap Lease+  deriving (Show)++instance Eq LeaseWrap where+  LeaseWrap a == LeaseWrap b = leaseEq a b++leaseEq :: Lease -> Lease -> Bool+leaseEq (Lease ipA valsA) (Lease ipB valsB) =+  ipA == ipB && L.sort valsA == L.sort valsB+