diff --git a/HostAndPort.cabal b/HostAndPort.cabal new file mode 100644 --- /dev/null +++ b/HostAndPort.cabal @@ -0,0 +1,62 @@ +name: HostAndPort +version: 0.1.0 +license: MIT +license-file: LICENSE +author: Slava Bacherikov +maintainer: slava@bacher09.org +homepage: https://github.com/bacher09/hostandport +bug-reports: https://github.com/bacher09/hostandport/issues +copyright: (c) Slava Bacherikov 2015 +category: Network +build-type: Simple +cabal-version: >=1.10 +synopsis: Parser host and port pairs like localhost:22 +description: + + Simple parser for parsing host and port pairs. + Host can be either ipv4, ipv6 or domain name and port are + optional. + . + IPv6 address should be surrounded by square brackets. + . + Examples: + . + * localhost + * localhost:8080 + * 127.0.0.1 + * 127.0.0.1:8080 + * [::1] + * [::1]:8080 + +library + exposed-modules: Network.HostAndPort + build-depends: base >=4.5 && <5, + parsec >=3.1 + hs-source-dirs: src + ghc-options: -O2 -funbox-strict-fields -Wall -fno-warn-name-shadowing + default-language: Haskell2010 + +test-suite tests + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Spec.hs + ghc-options: -O2 -funbox-strict-fields -Wall -fno-warn-name-shadowing + build-depends: base >=4.5 && <5, + HostAndPort, + hspec + +test-suite doctests + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Doctests.hs + ghc-options: -threaded + build-depends: base >=4.5 && <5, + HostAndPort, + doctest + + +source-repository head + type: git + location: https://github.com/bacher09/darkplaces-rcon.git diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2015 Slava Bacherikov + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Network/HostAndPort.hs b/src/Network/HostAndPort.hs new file mode 100644 --- /dev/null +++ b/src/Network/HostAndPort.hs @@ -0,0 +1,209 @@ +module Network.HostAndPort ( + isIPv4Address, + isIPv6Address, + hostAndPort, + maybeHostAndPort, + defaultHostAndPort +) where +import Text.Parsec +import Control.Applicative hiding((<|>), many) +import Control.Monad +import Data.Maybe + + +type Parser = Parsec String () + + +countMinMax :: (Stream s m t) => Int -> Int -> ParsecT s u m a -> ParsecT s u m [a] +countMinMax m x p + | m > 0 = do + f <- p + end <- countMinMax (m - 1) (x - 1) p + return $ f : end + | x <= 0 = return [] + | otherwise = option [] $ do + f <- p + end <- countMinMax 0 (x - 1) p + return $ f : end + + +intDigits :: Int -> Int +intDigits = length . show + + +limitedInt :: Int -> String -> Parser String +limitedInt x e = do + b <- countMinMax 1 (intDigits x) digit + if (read b :: Int) > x + then fail e + else return b + + +byteNum :: Parser String +byteNum = limitedInt 255 "Value to large" + + +consequence :: (Monad m) => [m [a]] -> m [a] +consequence v = liftM concat $ sequence v + + +ipv4address :: Parser String +ipv4address = consequence [ + byteNum, string ".", + byteNum, string ".", + byteNum, string ".", byteNum] "bad IPv4 address" + + +hexShortNum :: Parser String +hexShortNum = countMinMax 1 4 hexDigit + + +port :: Parser String +port = limitedInt 65535 "Port number to large" + + +ipv6address :: Parser String +ipv6address = do + let ipv6variants = (try <$> skippedAtBegin) + ++ [try full] + ++ (try <$> skippedAtMiddle) + ++ (try <$> skippedAtEnd) + ++ [last2 False] + choice ipv6variants "bad IPv6 address" + where + h4s = (++) <$> hexShortNum <*> string ":" + sh4 = (++) <$> string ":" <*> hexShortNum + execNum 0 = return "" + execNum n = concat <$> count n h4s + partNum 0 = return "" + partNum n = do + f <- hexShortNum + e <- countMinMax 0 (n - 1) (try sh4) + return $ f ++ concat e + + maybeNum n = concat <$> countMinMax 0 n h4s + last2f = try ipv4address <|> consequence [h4s, hexShortNum] + last2 f = if f + then last2f + else choice [try $ last2f, + try $ consequence [string "::", hexShortNum], + consequence [hexShortNum, string "::"]] + + skippedAtBegin = + map (\i -> consequence [string "::", execNum i, last2 True]) [5,4..0] + + skippedAtMiddle = [ + consequence [partNum 1, string "::", maybeNum 4, last2 True], + consequence [partNum 2, string "::", maybeNum 3, last2 True], + consequence [partNum 3, string "::", maybeNum 2, last2 True], + consequence [partNum 4, string "::", maybeNum 1, last2 True], + consequence [partNum 5, string "::", last2 True], + consequence [partNum 6, string "::", hexShortNum]] + + skippedAtEnd = [consequence [partNum 7, string "::"]] + + full = consequence [concat <$> count 6 h4s, last2 True] + + +ipv6addressWithScope :: Parser String +ipv6addressWithScope = consequence [ipv6address, option "" scope] + where + scope = consequence [string "%", many1 asciiAlphaNum] + + +hostname :: Parser String +hostname = many1 $ alphaNum <|> oneOf ".-_" + + +isParsed :: Parser a -> String -> Bool +isParsed p s = case runParser p () "" s of + (Right _) -> True + (Left _) -> False + + +-- | This function will validate ipv4 address +-- and return True if string is valie adress +isIPv4Address :: String -> Bool +isIPv4Address = isParsed $ ipv4address <* eof + + +-- | Function validates ipv6 address +isIPv6Address :: String -> Bool +isIPv6Address = isParsed $ ipv6addressWithScope <* eof + + +isAsciiAlpha :: Char -> Bool +isAsciiAlpha c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') + + +isAsciiNum :: Char -> Bool +isAsciiNum c = (c >= '0' && c <= '9') + + +isAsciiAlphaNum :: Char -> Bool +isAsciiAlphaNum c = isAsciiAlpha c || isAsciiNum c + + +asciiAlphaNum :: Parser Char +asciiAlphaNum = satisfy isAsciiAlphaNum + + +connectionStr :: Parser (String, Maybe String) +connectionStr = do + addr <- try ipv6str <|> try ipv4address <|> hostname + p <- maybePort + return (addr, p) + where + ipv6str = do + void $ char '[' + ipv6 <- ipv6addressWithScope + void $ char ']' + return ipv6 + maybePort = option Nothing $ char ':' >> Just <$> port + +-- | This function will parse it's argument and return either +-- `String` (`Left`) with info about error or (Host, `Maybe` Port) +-- tuple (`Right`). +-- +-- Examples: +-- +-- >>> hostAndPort "localhost" +-- Right ("localhost",Nothing) +-- >>> hostAndPort "[::1]:3030" +-- Right ("::1",Just "3030") +hostAndPort :: String -> Either String (String, Maybe String) +hostAndPort s = case runParser (connectionStr <* eof) () "" s of + (Right v) -> Right v + (Left e) -> Left $ show $ e + + +-- | Function will parse argument and return Maybe (Host, Maybe Port) +-- +-- Examples: +-- +-- >>> maybeHostAndPort "192.168.10.12" +-- Just ("192.168.10.12",Nothing) +-- >>> maybeHostAndPort "192.168.10.12:7272" +-- Just ("192.168.10.12",Just "7272") +maybeHostAndPort :: String -> Maybe (String, Maybe String) +maybeHostAndPort s = case hostAndPort s of + (Right v) -> Just v + (Left _) -> Nothing + + +-- | Function will take default port and connection string +-- and returns Just (Host, Port) for valid input and +-- Nothing for invalid. +-- +-- Examples: +-- +-- >>> defaultHostAndPort "22" "my.server.com" +-- Just ("my.server.com","22") +-- >>> defaultHostAndPort "22" "my.otherserver.com:54022" +-- Just ("my.otherserver.com","54022") +-- >>> defaultHostAndPort "22" "porttobig.com:500022" +-- Nothing +defaultHostAndPort :: String -- ^ default Port number + -> String -- ^ connection string + -> Maybe (String, String) -- ^ Maybe (Host, Port) +defaultHostAndPort p s = (\(h, mp) -> (h, fromMaybe p mp)) <$> maybeHostAndPort s diff --git a/tests/Doctests.hs b/tests/Doctests.hs new file mode 100644 --- /dev/null +++ b/tests/Doctests.hs @@ -0,0 +1,2 @@ +import Test.DocTest +main = doctest ["-isrc", "src/Network/HostAndPort.hs"] diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,95 @@ +module Main where +import Test.Hspec +import Network.HostAndPort +import Text.Printf + + +main :: IO () +main = hspec spec + + +spec :: Spec +spec = do + describe "isIPv4Address" $ do + valid isIPv4Address "127.0.0.1" + valid isIPv4Address "255.255.255.255" + + invalid isIPv4Address " 127.0.0.1" + invalid isIPv4Address "127.0.0.1 " + + invalid isIPv4Address "9.9.256.1" + + describe "isIPv6Address" $ do + valid isIPv6Address "::1" + valid isIPv6Address "::1:2" + valid isIPv6Address "::1:2:3" + valid isIPv6Address "::1:2:3:4" + valid isIPv6Address "::1:2:3:4:5" + valid isIPv6Address "::1:2:3:4:5:6" + valid isIPv6Address "::1:2:3:4:5:6:7" + valid isIPv6Address "1:2:3:4:5:6:7:8" + valid isIPv6Address "::192.168.1.10" + valid isIPv6Address "1::192.168.1.10" + valid isIPv6Address "1:2::192.168.1.10" + valid isIPv6Address "1:2:3::192.168.1.10" + valid isIPv6Address "1:2:3:4::192.168.1.10" + valid isIPv6Address "1:2:3:4:5::192.168.1.10" + valid isIPv6Address "::1:192.168.1.10" + valid isIPv6Address "::1:2:192.168.1.10" + valid isIPv6Address "::1:2:3:192.168.1.10" + valid isIPv6Address "::1:2:3:4:192.168.1.10" + valid isIPv6Address "::1:2:3:4:5:192.168.1.10" + valid isIPv6Address "::1:2:3:4:5:192.168.1.10" + valid isIPv6Address "ff::192.168.1.10" + valid isIPv6Address "1:2:3:4:5:6:127.0.0.1" + valid isIPv6Address "1::" + valid isIPv6Address "1:2::" + valid isIPv6Address "1:2:3::" + valid isIPv6Address "1:2:3:4::" + valid isIPv6Address "1:2:3:4:5::" + valid isIPv6Address "1:2:3:4:5:6::" + valid isIPv6Address "1:2:3:4:5:6:7::" + valid isIPv6Address "1::f" + valid isIPv6Address "1:2::f" + valid isIPv6Address "1:2:3::f" + valid isIPv6Address "1:2:3:4::f" + valid isIPv6Address "1:2:3:4:5::f" + valid isIPv6Address "1:2:3:4:5:6::f" + valid isIPv6Address "1:2:3:4:5::6:f" + valid isIPv6Address "1:2:3:4::5:6:f" + valid isIPv6Address "1:2:3::4:5:6:f" + valid isIPv6Address "1:2::3:4:5:6:f" + valid isIPv6Address "1::2:3:4:5:6:f" + valid isIPv6Address "::1:2:3:4:5:6:f" + valid isIPv6Address "::ffff:0:255.255.255.255" + valid isIPv6Address "fe80::7:8%eth0" + valid isIPv6Address "fe80::7:8%11" + + invalid isIPv6Address "::" + invalid isIPv6Address "1:2:3:4:5:6:7:8:9" + invalid isIPv6Address "1:2:3:4:5:6:7:" + invalid isIPv6Address "1:2:3:4:5:6:7" + invalid isIPv6Address ":1:2:3:4:5:6:7" + invalid isIPv6Address "1:2:3:4:5:6:7:10.0.0.1" + invalid isIPv6Address "::1:2:3:4:5:6:7:8" + invalid isIPv6Address "1:2:3:4:5:6::192.168.1.10" + invalid isIPv6Address "1:2:3:4:5:6:7:8::" + + describe "defaultHostAndPort" $ do + it "parsing hosts" $ do + defaultHostAndPort "40" "localhost:25" `shouldBe` Just ("localhost", "25") + + it "parsing ipv4" $ do + defaultHostAndPort "80" "127.0.0.1:8080" `shouldBe` Just ("127.0.0.1", "8080") + defaultHostAndPort "80" "127.0.0.1" `shouldBe` Just ("127.0.0.1", "80") + + it "parsing ipv6" $ do + defaultHostAndPort "26000" "[f08e::7:8:1]" `shouldBe` Just ("f08e::7:8:1", "26000") + defaultHostAndPort "26000" "[f08e::7:8:1]:27000" `shouldBe` Just ("f08e::7:8:1", "27000") + + it "testing invalid" $ do + defaultHostAndPort "60" "localhost:99999" `shouldBe` Nothing + defaultHostAndPort "60" "[bad]:25" `shouldBe` Nothing + where + valid f s = it (printf "valid \"%s\"" s) (f s `shouldBe` True) + invalid f s = it (printf "invalid \"%s\"" s) (f s `shouldBe` False)