diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (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 Author name here 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +# ping-parser-attoparsec +[![Travis](https://img.shields.io/travis/frincon/ping-parser-attoparsec.svg)](https://travis-ci.org/frincon/ping-parser-attoparsec) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,16 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +import Distribution.Simple + +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,21 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE TemplateHaskell #-} + +module Main where + +import Development.Placeholders + +main :: IO () +main = $notImplemented diff --git a/ping-parser-attoparsec.cabal b/ping-parser-attoparsec.cabal new file mode 100644 --- /dev/null +++ b/ping-parser-attoparsec.cabal @@ -0,0 +1,57 @@ +name: ping-parser-attoparsec +version: 0.1.0.0 +stability: experimental +synopsis: Attoparsec parsers of ping utility +description: + Attoparsec parsers of the output of ping utility. Currently there is only + one implementation for the Win32 version of ping and only support IPv4. +homepage: https://github.com/frincon/ping-parser-attoparsec +bug-reports: https://github.com/frincon/ping-parser-attoparsec/issues +license: Apache-2.0 +license-file: LICENSE +author: Fernando Rincon Martin +maintainer: frm.rincon@gmail.com +copyright: (c) 2017, Fernando Rincon Martin +category: Attoparsec, Parsers +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Data.Attoparsec.Ping + , Data.Attoparsec.Ping.Win32 + build-depends: base >= 4.7 && < 5 + , placeholders + , attoparsec + , text + , iproute + default-language: Haskell2010 + +executable ping-parser-attoparsec-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , ping-parser-attoparsec + , placeholders + default-language: Haskell2010 + +test-suite ping-parser-attoparsec-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: Spec.Win32 + build-depends: base + , ping-parser-attoparsec + , hspec + , attoparsec + , QuickCheck + , quickcheck-text + , iproute + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/frincon/ping-parser-attoparsec diff --git a/src/Data/Attoparsec/Ping.hs b/src/Data/Attoparsec/Ping.hs new file mode 100644 --- /dev/null +++ b/src/Data/Attoparsec/Ping.hs @@ -0,0 +1,59 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +{-| +Parser for ping output. Common Types. +-} +module Data.Attoparsec.Ping + ( PingResult(..) + , PingError(..) + , LineResult(..) + , ReplyResult(..) + ) where + +import Control.Applicative ((<|>)) +import Data.Attoparsec.Text +import Data.IP +import Data.Text (Text) +import qualified Data.Text as T +import Data.Word (Word32) +import Development.Placeholders + +data PingResult + = PingSucceed { hostAddress :: IPv4 + , hostNameResolved :: Maybe Text + , bytesOfData :: Int + , lineResults :: [LineResult] } + | PingError PingError + deriving (Eq, Show) + +data PingError = + HostNotFound Text + deriving (Eq, Show) + +data LineResult + = ReplyFrom IPv4 + ReplyResult + | RequestTimedOut + | GeneralFailure + deriving (Eq, Show) + +data ReplyResult + = ResponseReceived { bytes :: Int + , timeInMs :: Int + , ttl :: Int } + | DestinationHostUnreachable + deriving (Eq, Show) diff --git a/src/Data/Attoparsec/Ping/Win32.hs b/src/Data/Attoparsec/Ping/Win32.hs new file mode 100644 --- /dev/null +++ b/src/Data/Attoparsec/Ping/Win32.hs @@ -0,0 +1,114 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +{-| +Parser for ping output. Parser for the output of Win32 ping utility. +-} +module Data.Attoparsec.Ping.Win32 + ( pingParser + , module Data.Attoparsec.Ping + ) where + +import Control.Applicative ((<|>)) +import Data.Attoparsec.Ping +import Data.Attoparsec.Text +import Data.IP +import Data.Text (Text) +import qualified Data.Text as T +import Data.Word (Word32) +import Development.Placeholders + +pingParser :: Parser PingResult +pingParser = parseHostNotFound <|> parseSucceed <|> fail "Not recognized input" + +parseHostNotFound :: Parser PingResult +parseHostNotFound = do + string "Ping request could not find host " + hostName <- manyTill anyChar (string ". ") + string "Please check the name and try again." + return $ PingError $ HostNotFound (T.pack hostName) + +parseSucceed :: Parser PingResult +parseSucceed = do + endOfLine + string "Pinging " + (maybeHostName, hostAddress) <- parseHostNameAndAddress + bytesOfData <- decimal + string " bytes of data:" + endOfLine + lineResults <- parseLineResults + return + PingSucceed + { hostAddress = hostAddress + , hostNameResolved = maybeHostName + , bytesOfData = bytesOfData + , lineResults = lineResults + } + +parseHostNameAndAddress :: Parser (Maybe Text, IPv4) +parseHostNameAndAddress = do + hostNameAndOrAddress <- T.pack <$> manyTill anyChar (string " with ") + case T.words hostNameAndOrAddress of + [address] -> return (Nothing, parseIp4 address) + [hostName, addressWithBrackets] -> + return (Just hostName, parseIp4WithBrackets addressWithBrackets) + where + parseIp4 address = read (T.unpack address) + parseIp4WithBrackets addressWithBrackets = + parseIp4 (T.drop 1 (T.dropEnd 1 addressWithBrackets)) + +parseLineResults :: Parser [LineResult] +parseLineResults = manyTill parseLineResult endOfLine + +parseLineResult :: Parser LineResult +parseLineResult = + parseRequestTimedOut <|> parseGeneralFailure <|> parseReplyFrom + +parseRequestTimedOut :: Parser LineResult +parseRequestTimedOut = do + string "Request timed out." + endOfLine + return RequestTimedOut + +parseGeneralFailure :: Parser LineResult +parseGeneralFailure = do + string "General failure." + endOfLine + return GeneralFailure + +parseReplyFrom :: Parser LineResult +parseReplyFrom = do + string "Reply from " + address <- read <$> manyTill anyChar (char ':') + replayResult <- parseReplyResult + return $ ReplyFrom address replayResult + +parseReplyResult = parseDestinationHostUnreachable <|> parseResponseReceived + +parseDestinationHostUnreachable = do + string " Destination host unreachable." + endOfLine + return DestinationHostUnreachable + +parseResponseReceived = do + string " bytes=" + bytes <- decimal + string " time" + timeInMs <- (string "<1" *> return 0) <|> (char '=' *> decimal) + string "ms TTL=" + ttl <- decimal + endOfLine + return ResponseReceived {bytes = bytes, timeInMs = timeInMs, ttl = ttl} diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,20 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE OverloadedStrings #-} + +import Spec.Win32 +import Test.Hspec + +main :: IO () +main = hspec Spec.Win32.spec diff --git a/test/Spec/Win32.hs b/test/Spec/Win32.hs new file mode 100644 --- /dev/null +++ b/test/Spec/Win32.hs @@ -0,0 +1,98 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE OverloadedStrings #-} + +module Spec.Win32 + ( spec + ) where + +import Test.Hspec +import Test.QuickCheck + +import Data.Attoparsec.Ping.Win32 +import Data.Attoparsec.Text (parseOnly) +import Data.Either (isLeft) +import Data.Text.Arbitrary + +hostNotFoundString = + "Ping request could not find host unknown.host.com. \ + \Please check the name and try again.\n\ + \" + +ping4TimesToIp = + "\n\ + \Pinging 127.0.0.1 with 32 bytes of data:\n\ + \Request timed out.\n\ + \Reply from 127.0.0.1: Destination host unreachable.\n\ + \Reply from 127.0.0.1: bytes=32 time=121ms TTL=128\n\ + \Reply from 127.0.0.1: bytes=32 time<1ms TTL=128\n\ + \\n\ + \Ping statistics for 127.0.0.1:\n\ + \ Packets: Sent = 4, Received = 4, Lost = 0 (0% loss),\n\ + \Approximate round trip times in milli-seconds:\n\ + \ Minimum = 0ms, Maximum = 0ms, Average = 0ms\n\ + \" + +ping4TimesToIpWithHostName = + "\n\ + \Pinging the.host.name [127.0.0.1] with 32 bytes of data:\n\ + \Request timed out.\n\ + \Reply from 127.0.0.1: Destination host unreachable.\n\ + \Reply from 127.0.0.1: bytes=32 time=121ms TTL=128\n\ + \Reply from 127.0.0.1: bytes=32 time<1ms TTL=128\n\ + \\n\ + \Ping statistics for 127.0.0.1:\n\ + \ Packets: Sent = 4, Received = 4, Lost = 0 (0% loss),\n\ + \Approximate round trip times in milli-seconds:\n\ + \ Minimum = 0ms, Maximum = 0ms, Average = 0ms\n\ + \" + +expectedLines :: [LineResult] +expectedLines = + [ RequestTimedOut + , ReplyFrom (read "127.0.0.1") DestinationHostUnreachable + , ReplyFrom + (read "127.0.0.1") + ResponseReceived {bytes = 32, timeInMs = 121, ttl = 128} + , ReplyFrom + (read "127.0.0.1") + ResponseReceived {bytes = 32, timeInMs = 0, ttl = 128} + ] + +spec :: Spec +spec = + describe "Data.Attoparsec.Ping.Win32.pingResult" $ do + it "returns PingError HostNotFound when host not found" $ + parseOnly pingParser hostNotFoundString `shouldBe` + Right (PingError $ HostNotFound "unknown.host.com") + it "returns PingResult when pinging ip" $ + parseOnly pingParser ping4TimesToIp `shouldBe` + Right + PingSucceed + { hostAddress = read "127.0.0.1" + , hostNameResolved = Nothing + , bytesOfData = 32 + , lineResults = expectedLines + } + it "returns PingResult when pinging hostname" $ + parseOnly pingParser ping4TimesToIpWithHostName `shouldBe` + Right + PingSucceed + { hostAddress = read "127.0.0.1" + , hostNameResolved = Just "the.host.name" + , bytesOfData = 32 + , lineResults = expectedLines + } + it "returns Fails when random string" $ + property $ \x -> parseOnly pingParser x `shouldSatisfy` isLeft