summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2018-01-14 15:09:21 +0100
committerYorhel <git@yorhel.nl>2018-01-14 15:10:05 +0100
commit4599d27a0d5a851d88ead033580f9d0cba3067d9 (patch)
tree4ce81cf2ec00fa4395222f4d4b67462024b594f0
parent8f7ec93a6f45031fa79f0c04f9952f4b929d2ee7 (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.hs65
-rw-r--r--nginx-confgen.cabal4
-rw-r--r--test/main.conf6
3 files changed, 46 insertions, 29 deletions
diff --git a/Main.hs b/Main.hs
index 9e6cc29..ed4cb64 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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.
}