diff options
author | Yorhel <git@yorhel.nl> | 2018-01-14 15:09:21 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2018-01-14 15:10:05 +0100 |
commit | 4599d27a0d5a851d88ead033580f9d0cba3067d9 (patch) | |
tree | 4ce81cf2ec00fa4395222f4d4b67462024b594f0 | |
parent | 8f7ec93a6f45031fa79f0c04f9952f4b929d2ee7 (diff) |
Add capture support for pre_if regexes
'pre_if' should now have feature parity with the 'if' in nginx. The
nginx docs does do not mention $0, but this implementation will also set
it.
-rw-r--r-- | Main.hs | 65 | ||||
-rw-r--r-- | nginx-confgen.cabal | 4 | ||||
-rw-r--r-- | test/main.conf | 6 |
3 files changed, 46 insertions, 29 deletions
@@ -4,6 +4,7 @@ module Main where import Control.Applicative (empty) import Control.Exception.Base (throwIO,Exception) import Control.Monad (void,foldM,join) +import qualified Data.Array as A import Data.Char (isSpace) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as M @@ -60,12 +61,13 @@ parser = between ws eof $ many stmt identifier = (:) <$> letterChar <*> many (alphaNumChar <|> char '_') + scalarname = identifier <|> some digitChar blockvar, arrayvar, scalarvar :: Parser String blockvar = lexeme (char '&' >> identifier) arrayvar = lexeme (char '@' >> identifier) scalarvar = char '$' - >> between (char '{') (char '}') identifier - <|> identifier + >> between (char '{') (char '}') scalarname + <|> scalarname arg :: Parser Arg arg = ArgArray <$> arrayvar @@ -252,41 +254,44 @@ macroExpand m iargs iblock = do -- [Arg] should not have been interpolated yet, otherwise rmParen may remove -- parenthesis from variables. +-- Conf should also not have been interpolated ifExpand :: PState -> [Arg] -> Conf -> IO Conf ifExpand st arg conf = do -- Turn Arg into [ArgComponent] and remove parenthesis args <- filter (not.null) . fmap (filter isNonEmpty) . rmParen <$> mapM validateArg arg - ok <- case args of + (st', ok) <- case args of -- Single argument, test if true/false [v] -> do v' <- interpArg v - return $ v' /= "" && v' /= "0" + return $ (st, v' /= "" && v' /= "0") -- Equality/inequality - [a, [Literal "=" ], b] -> (==) <$> interpArg a <*> interpArg b - [a, [Literal "!="], b] -> (/=) <$> interpArg a <*> interpArg b + [a, [Literal "=" ], b] -> (st,) <$> ((==) <$> interpArg a <*> interpArg b) + [a, [Literal "!="], b] -> (st,) <$> ((/=) <$> interpArg a <*> interpArg b) -- Regex - [a, [Literal "~" ], b] -> regex a b True - [a, [Literal "~*" ], b] -> regex a b False - [a, [Literal "!~" ], b] -> not <$> regex a b True - [a, [Literal "!~*" ], b] -> not <$> regex a b False - - -- File tests - [[Literal "-f"], a] -> interpArg a >>= doesFileExist - [[Literal "!-f"], a] -> not <$> (interpArg a >>= doesFileExist) - [[Literal "-d"], a] -> interpArg a >>= doesDirectoryExist - [[Literal "!-d"], a] -> not <$> (interpArg a >>= doesDirectoryExist) - [[Literal "-e"], a] -> interpArg a >>= doesPathExist - [[Literal "!-e"], a] -> not <$> (interpArg a >>= doesPathExist) - [[Literal "-x"], a] -> interpArg a >>= doesExecutableExist - [[Literal "!-x"], a] -> not <$> (interpArg a >>= doesExecutableExist) + [a, [Literal "~" ], b] -> regex a b True + [a, [Literal "~*" ], b] -> regex a b False + [a, [Literal "!~" ], b] -> (fmap . fmap) not $ regex a b True + [a, [Literal "!~*" ], b] -> (fmap . fmap) not $ regex a b False + + ---- File tests + [[Literal "-f"], a] -> (st,) <$> ( interpArg a >>= doesFileExist) + [[Literal "!-f"], a] -> (st,) <$> (not <$> (interpArg a >>= doesFileExist)) + [[Literal "-d"], a] -> (st,) <$> ( interpArg a >>= doesDirectoryExist) + [[Literal "!-d"], a] -> (st,) <$> (not <$> (interpArg a >>= doesDirectoryExist)) + [[Literal "-e"], a] -> (st,) <$> ( interpArg a >>= doesPathExist) + [[Literal "!-e"], a] -> (st,) <$> (not <$> (interpArg a >>= doesPathExist)) + [[Literal "-x"], a] -> (st,) <$> ( interpArg a >>= doesExecutableExist) + [[Literal "!-x"], a] -> (st,) <$> (not <$> (interpArg a >>= doesExecutableExist)) -- Dunno _ -> throwIO IfUnknown - return $ if ok then conf else [] + if ok + then procConf' st' conf + else return [] where -- All arguments must be fully evaluated ArgStrings @@ -338,13 +343,23 @@ ifExpand st arg conf = do doesExecutableExist p = either (const False) executable <$> tryIOError (getPermissions p) -- Regex matching - regex :: [ArgComponent] -> [ArgComponent] -> Bool -> IO Bool + regex :: [ArgComponent] -> [ArgComponent] -> Bool -> IO (PState, Bool) regex a' b' caseSen = do a <- interpArg a' b <- interpArg b' - case R.makeRegexOptsM (R.defaultCompOpt { R.caseSensitive = caseSen }) R.defaultExecOpt b of + -- 'Either String' does not implement fail, but 'Maybe' does. Go figure. + reg <- case R.makeRegexOptsM (R.defaultCompOpt { R.caseSensitive = caseSen }) R.defaultExecOpt b of Nothing -> throwIO (InvalidRegex b) - Just r -> return $ R.matchTest r a + Just r -> return r + case R.matchOnceText reg a of + Nothing -> return (st, False) + Just (_, res, _) -> + let nargs = foldr (\(n,(s,_)) i -> M.insert (show n) [Literal s] i) + (stArgs st) + (A.assocs res) + st' = st { stArgs = nargs } + in return (st', True) + @@ -421,7 +436,7 @@ procConf gst gconf = foldM p (gst, []) gconf stmt st (Directive "pre_if" a b) = (st,) <$> case b of Nothing -> throwIO IfNeedsBlock - Just b' -> procConf' st b' >>= ifExpand st a + Just b' -> ifExpand st a b' stmt st (Directive name a b) = (st,) <$> do a' <- procArg st a diff --git a/nginx-confgen.cabal b/nginx-confgen.cabal index 03872c9..f63de25 100644 --- a/nginx-confgen.cabal +++ b/nginx-confgen.cabal @@ -16,7 +16,9 @@ executable nginx-confgen ghc-options: -Wall main-is: Main.hs default-language: Haskell2010 - build-depends: base + build-depends: + array + , base , directory , megaparsec , regex-tdfa diff --git a/test/main.conf b/test/main.conf index 53fb67b..e62226b 100644 --- a/test/main.conf +++ b/test/main.conf @@ -7,10 +7,10 @@ events { } -pre_set $name "a"; #" This is the \$name variable"; # Set a variable +pre_set $name "abc"; #" This is the \$name variable"; # Set a variable -pre_if ($name !~* A) { - the pre_if matched; +pre_if ($name ~* (B)c) { + the pre_if matched $1; pre_set $var 2; # Not visible outside of this pre_if block... hmmmm. } |