We have an existing uuidRegex with which UUIDs can be checked, but it is conditionally compiled if Ganeti is configured with regex-pcre support, and we don't want to make the dependency on that unconditional.
This implements `isUUID` with an Attoparsec parser that is equivalent to the `uuidRegex`. Signed-off-by: Niklas Hambuechen <[email protected]> --- src/Ganeti/Utils.hs | 24 ++++++++++++++++++++++++ test/hs/Test/Ganeti/Utils.hs | 15 +++++++++++---- 2 files changed, 35 insertions(+), 4 deletions(-) diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs index 9f20b5e..638ca35 100644 --- a/src/Ganeti/Utils.hs +++ b/src/Ganeti/Utils.hs @@ -51,6 +51,7 @@ module Ganeti.Utils , logWarningIfBad , rStripSpace , newUUID + , isUUID , getCurrentTime , getCurrentTimeUSec , clockTimeToString @@ -84,10 +85,13 @@ module Ganeti.Utils , ordNub ) where +import Control.Applicative import Control.Concurrent import Control.Exception (try, bracket) import Control.Monad import Control.Monad.Error +import qualified Data.Attoparsec as A +import qualified Data.ByteString.Char8 as BS8 import Data.Char (toUpper, isAlphaNum, isDigit, isSpace) import qualified Data.Either as E import Data.Function (on) @@ -399,6 +403,26 @@ newUUID = do contents <- readFile ConstantUtils.randomUuidFile return $! rStripSpace $ take 128 contents +-- | Parser that doesn't fail on a valid UUIDs (same as +-- "Ganeti.Constants.uuidRegex"). +uuidCheckParser :: A.Parser () +uuidCheckParser = do + -- Not using Attoparsec.Char8 because "all attempts to use characters + -- above code point U+00FF will give wrong answers" and we don't + -- want such things to be accepted as UUIDs. + let lowerHex = A.satisfy (\c -> (48 <= c && c <= 57) || -- 0-9 + (97 <= c && c <= 102)) -- a-f + hx n = A.count n lowerHex + d = A.word8 45 -- '-' + void $ hx 8 >> d >> hx 4 >> d >> hx 4 >> d >> hx 4 >> d >> hx 12 + +-- | Checks if the string is a valid UUID as in "Ganeti.Constants.uuidRegex". +isUUID :: String -> Bool +isUUID u = + case A.parseOnly (uuidCheckParser <* A.endOfInput) $ BS8.pack u of + Right () -> True + Left _ -> False + -- | Returns the current time as an 'Integer' representing the number -- of seconds from the Unix epoch. getCurrentTime :: IO Integer diff --git a/test/hs/Test/Ganeti/Utils.hs b/test/hs/Test/Ganeti/Utils.hs index 817d369..181b03f 100644 --- a/test/hs/Test/Ganeti/Utils.hs +++ b/test/hs/Test/Ganeti/Utils.hs @@ -251,13 +251,19 @@ prop_rStripSpace (NonEmpty str) = rStripSpace "" ==? "" ] -#ifndef NO_REGEX_PCRE -{-# ANN case_new_uuid "HLint: ignore Use camelCase" #-} - -- | Tests that the newUUID function produces valid UUIDs. case_new_uuid :: Assertion case_new_uuid = do uuid <- newUUID + assertBool "newUUID" $ isUUID uuid + +#ifndef NO_REGEX_PCRE +{-# ANN case_new_uuid_regex "HLint: ignore Use camelCase" #-} + +-- | Tests that the newUUID function produces valid UUIDs. +case_new_uuid_regex :: Assertion +case_new_uuid_regex = do + uuid <- newUUID assertBool "newUUID" $ uuid =~ C.uuidRegex #endif @@ -358,8 +364,9 @@ testSuite "Utils" , 'prop_niceSortKey_equiv , 'prop_rStripSpace , 'prop_trim -#ifndef NO_REGEX_PCRE , 'case_new_uuid +#ifndef NO_REGEX_PCRE + , 'case_new_uuid_regex #endif , 'prop_clockTimeToString , 'prop_chompPrefix_normal -- 2.1.0.rc2.206.gedb03e5
