Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

import what's done already

  • Loading branch information...
commit 15d1db77c79f0c135d13ff4f8a8b79009afd86a4 1 parent 7417780
Sergey Shepelev authored August 20, 2010
24  Makefile
... ...
@@ -0,0 +1,24 @@
  1
+# nginxlint make recipe
  2
+
  3
+# settings
  4
+HC := ghc
  5
+
  6
+# Don't modify anything below without a reason.
  7
+srcs := \
  8
+	NginxLint/Data.hs \
  9
+	NginxLint/Hint.hs \
  10
+	NginxLint/Main.hs \
  11
+	NginxLint/Parse.hs
  12
+
  13
+.PHONY: all clean test
  14
+
  15
+all: nginxlint
  16
+
  17
+clean:
  18
+	@rm -f nginxlint $(patsubst %.hs,%.hi,${srcs}) $(patsubst %.hs,%.o,${srcs})
  19
+
  20
+nginxlint: ${srcs}
  21
+	@$(HC) --make ${srcs} -o $@
  22
+
  23
+test: nginxlint
  24
+	@./nginxlint test.conf
90  NginxLint/Data.hs
... ...
@@ -0,0 +1,90 @@
  1
+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses #-}
  2
+module NginxLint.Data where
  3
+
  4
+import Data.Data
  5
+import Data.Generics.Str
  6
+import Data.Generics.Uniplate.Operations
  7
+import Data.List (intercalate)
  8
+import qualified Text.ParserCombinators.Parsec as P
  9
+
  10
+
  11
+type Ident = String
  12
+
  13
+data NgFile = NgFile FilePath [Decl]
  14
+    deriving (Eq, Show)
  15
+
  16
+data Arg
  17
+    = RawString P.SourcePos String
  18
+    | QuotedString P.SourcePos String
  19
+    | Integer P.SourcePos Integer
  20
+    deriving (Data, Eq, Show, Typeable)
  21
+
  22
+data Decl
  23
+    = Decl P.SourcePos Ident [Arg]
  24
+    | Block P.SourcePos Ident [Arg] [Decl]
  25
+    | If P.SourcePos [Arg] [Decl]
  26
+    | Location P.SourcePos [Arg] [Decl]
  27
+    deriving (Data, Eq, Show, Typeable)
  28
+
  29
+instance Typeable P.SourcePos where
  30
+
  31
+instance Data P.SourcePos where
  32
+
  33
+instance Biplate NgFile Decl where
  34
+    biplate (NgFile fname ds) = (listStr ds, \newds -> NgFile fname (strList newds))
  35
+
  36
+instance Uniplate Decl where
  37
+    uniplate d@(Decl _ _ _) = (Zero, \Zero -> d)
  38
+    uniplate d@(Block pos ident args children) = (listStr children, \newds -> Block pos ident args (strList newds))
  39
+    uniplate d@(If    pos       args children) = (listStr children, \newds -> If pos args (strList newds))
  40
+    uniplate d@(Location pos    args children) = (listStr children, \newds -> If pos args (strList newds))
  41
+
  42
+
  43
+class NgPositioned a where
  44
+    ng_getPosition :: a -> P.SourcePos
  45
+
  46
+
  47
+instance NgPositioned Arg where
  48
+    ng_getPosition (RawString pos _) = pos
  49
+    ng_getPosition (QuotedString pos _) = pos
  50
+    ng_getPosition (Integer pos _) = pos
  51
+
  52
+instance NgPositioned Decl where
  53
+    ng_getPosition (Decl pos _ _) = pos
  54
+    ng_getPosition (Block pos _ _ _) = pos
  55
+
  56
+
  57
+-- Hint where, category, id, content
  58
+data Hint = Hint P.SourcePos String String String
  59
+
  60
+
  61
+instance NgPositioned Hint where
  62
+    ng_getPosition (Hint pos _ _ _) = pos
  63
+
  64
+
  65
+-- pretty print for P.SourcePos
  66
+ppSrcPos pos = P.sourceName pos ++ ":" ++ show (P.sourceLine pos)
  67
+               ++ ":" ++ show (P.sourceColumn pos)
  68
+
  69
+-- pretty print for Arg
  70
+ppArg (RawString    _ s) = s
  71
+ppArg (QuotedString _ s) = "\"" ++ s ++ "\""
  72
+ppArg (Integer      _ i) = show i
  73
+
  74
+ppArgList = concatMap (\a -> " " ++ ppArg a)
  75
+
  76
+-- pretty print for Decl
  77
+ppDecl (Decl  _ name args   ) = name ++ ppArgList args ++ ";\n"
  78
+ppDecl (Block _ name args ds) = name ++ ppArgList args ++ " {\n"
  79
+                                ++ concatMap (\d -> "    " ++ ppDecl d) ds
  80
+                                ++ "}\n"
  81
+ppDecl (If pos args ds) = "if ( " ++ ppArgList args ++ " ) {\n"
  82
+                          ++ concatMap (\d -> "    " ++ ppDecl d) ds
  83
+                          ++ "}\n"
  84
+ppDecl (Location pos args ds) = ppDecl $ Block pos "location" args ds
  85
+
  86
+
  87
+-- pretty print for Hint
  88
+ppHint h@(Hint _ cat ident content) = ppSrcPos pos ++ " "
  89
+        ++ cat ++ ":" ++ ident ++ ": " ++ content
  90
+    where pos = ng_getPosition h
59  NginxLint/Hint.hs
... ...
@@ -0,0 +1,59 @@
  1
+module NginxLint.Hint where
  2
+
  3
+import Data.List
  4
+import Data.Maybe
  5
+import Debug.Trace
  6
+import qualified Text.ParserCombinators.Parsec as P
  7
+
  8
+import NginxLint.Data
  9
+import NginxLint.Parse
  10
+
  11
+
  12
+argHints :: [Arg -> Maybe Hint]
  13
+argHints = [ hintArgExcessiveQuot
  14
+           ]
  15
+
  16
+declHints :: [Decl -> Maybe Hint]
  17
+declHints = [ hintDeclPrefixRegexNoCaptures
  18
+            ]
  19
+
  20
+analyzeDecl :: Decl -> [Hint]
  21
+analyzeDecl d = mapMaybe (\f -> f d) declHints
  22
+                ++ concatMap analyzeArg (extractDeclArgs d)
  23
+    where extractDeclArgs (Decl _ _ args) = args
  24
+          extractDeclArgs (Block _ _ args _) = args
  25
+
  26
+analyzeArg :: Arg -> [Hint]
  27
+analyzeArg arg = mapMaybe (\f -> f arg) argHints
  28
+
  29
+
  30
+declIsLocation (Block _ "location" _ _) = True
  31
+declIsLocation _ = False
  32
+
  33
+isLocationRegex (Block _ "location" [RawString _ op, _] _) = op `elem` ["~", "~*"]
  34
+isLocationRegex _ = False
  35
+
  36
+
  37
+hintDeclPrefixRegexNoCaptures :: Decl -> Maybe Hint
  38
+hintDeclPrefixRegexNoCaptures decl@(Block _ "location" [RawString _ op, RawString _ pat] _)
  39
+    | op == "~"
  40
+    && "^" `isPrefixOf` pat
  41
+    && not ("(" `isInfixOf` pat) = Just $
  42
+        Hint (ng_getPosition decl) "Loc" "prnc" ("Prefix regex location without captures: " ++ pat ++ " Use: location " ++ tail pat)
  43
+    | otherwise = Nothing
  44
+hintDeclPrefixRegexNoCaptures _ = Nothing
  45
+
  46
+
  47
+hintDeclIfFilename :: Decl -> Maybe Hint
  48
+hintDeclIfFilename decl@(Block _ "if" args _) = trace (show decl) Nothing
  49
+hintDeclIfFilename _ = Nothing
  50
+
  51
+
  52
+hintArgExcessiveQuot :: Arg -> Maybe Hint
  53
+hintArgExcessiveQuot arg@(QuotedString _ qs) =
  54
+    case P.parse plainString "" qs of
  55
+         Left _ -> Nothing
  56
+         Right (RawString _ s)
  57
+            | s == qs -> Just $ Hint (ng_getPosition arg) "Arg" "eq" ("Excessive quoting: \"" ++ qs ++ "\"")
  58
+            | otherwise -> Nothing
  59
+hintArgExcessiveQuot _ = Nothing
46  NginxLint/Main.hs
... ...
@@ -0,0 +1,46 @@
  1
+module Main where
  2
+
  3
+import Data.Generics.Uniplate.Operations
  4
+import System.Environment
  5
+import System.Exit
  6
+import System.IO
  7
+import Text.ParserCombinators.Parsec (parseFromFile)
  8
+
  9
+import NginxLint.Data
  10
+import NginxLint.Hint
  11
+import NginxLint.Parse
  12
+
  13
+
  14
+main = processFiles
  15
+
  16
+processFiles :: IO ()
  17
+processFiles = do
  18
+    args <- getArgs
  19
+    if length args >= 1 && head args == "-print"
  20
+       then mapM_ (processFile printParsed) (tail args)
  21
+       else mapM_ (processFile processHints) args
  22
+
  23
+processFile :: (NgFile -> IO ()) -> FilePath -> IO ()
  24
+processFile fun fname = do
  25
+    result <- parseFromFile parseFile fname
  26
+    case result of
  27
+         Left err -> do
  28
+             print err
  29
+             exitFailure
  30
+         Right ngfile -> fun ngfile
  31
+
  32
+processHints :: NgFile -> IO ()
  33
+processHints f@(NgFile fname _) = do_hints
  34
+    where
  35
+        do_hints = if null hints
  36
+                      then putStrLn (fname ++ ": No suggestions.")
  37
+                      else mapM_ (putStrLn . ppHint) hints
  38
+
  39
+        all_decls = universeBi f
  40
+        hints = concatMap analyzeDecl all_decls
  41
+
  42
+printParsed :: NgFile -> IO ()
  43
+printParsed (NgFile fname decls) = do
  44
+    putStrLn $ "# " ++ fname
  45
+    putStrLn $ "#"
  46
+    mapM_ (putStrLn . ppDecl) decls
93  NginxLint/Parse.hs
... ...
@@ -0,0 +1,93 @@
  1
+module NginxLint.Parse where
  2
+
  3
+import Debug.Trace
  4
+import Text.ParserCombinators.Parsec hiding (spaces)
  5
+import Text.ParserCombinators.Parsec.Language (emptyDef)
  6
+import qualified Text.ParserCombinators.Parsec.Token as T
  7
+
  8
+import NginxLint.Data
  9
+
  10
+
  11
+parseFile :: Parser NgFile
  12
+parseFile = do whiteSpace
  13
+               pos <- getPosition
  14
+               ds <- many decl
  15
+               eof
  16
+               return $ NgFile (sourceName pos) ds
  17
+
  18
+decl :: Parser Decl
  19
+decl = try ifDecl <|> nonIfDecl
  20
+
  21
+nonIfDecl = try blockDecl <|> oneDecl
  22
+
  23
+oneDecl = do whiteSpace
  24
+             pos <- getPosition
  25
+             name <- identifier
  26
+             args <- many argument
  27
+             lexeme (char ';')
  28
+             return $ Decl pos name args
  29
+          <?> "directive"
  30
+
  31
+blockDecl = do whiteSpace
  32
+               pos <- getPosition
  33
+               name <- identifier
  34
+               args <- try (many argument)
  35
+               ds <- braces (many decl)
  36
+               return $ Block pos name args ds
  37
+
  38
+ifDecl = do whiteSpace
  39
+            pos <- getPosition
  40
+            reserved "if"
  41
+            symbol "("
  42
+            args <- argument `manyTill` try (symbol ")")
  43
+            ds <- braces (many nonIfDecl)
  44
+            return $ Block pos "if" args ds
  45
+
  46
+argument :: Parser Arg
  47
+argument = quotedString <|> plainString
  48
+        <|> parseInteger
  49
+        <?> "directive argument"
  50
+
  51
+parseInteger = do pos <- getPosition
  52
+                  n <- integer
  53
+                  return $ Integer pos n
  54
+
  55
+quotedString = do pos <- getPosition
  56
+                  symbol "\""
  57
+                  s <- many (noneOf "\"")
  58
+                  symbol "\""
  59
+                  return $ QuotedString pos s
  60
+
  61
+plainString = do pos <- getPosition
  62
+                 s <- lexeme ps
  63
+                 return $ RawString pos s
  64
+              <?> "plain string"
  65
+    where ps = many1 (noneOf " \"\v\t\r\n(){};")
  66
+
  67
+
  68
+lexer :: T.TokenParser ()
  69
+lexer = T.makeTokenParser nginxDef
  70
+
  71
+nginxDef = emptyDef
  72
+    { T.commentLine    = "#"
  73
+    , T.nestedComments = False
  74
+    , T.opLetter       = oneOf "<=>"
  75
+    , T.reservedNames  = ["if"]
  76
+    }
  77
+
  78
+whiteSpace    = T.whiteSpace lexer
  79
+lexeme        = T.lexeme lexer
  80
+symbol        = T.symbol lexer
  81
+braces        = T.braces lexer
  82
+natural       = T.natural lexer
  83
+float         = T.float lexer
  84
+integer       = T.natural lexer
  85
+parens        = T.parens lexer
  86
+comma         = T.comma lexer
  87
+semi          = T.semi lexer
  88
+dot           = T.dot lexer
  89
+identifier    = T.identifier lexer
  90
+reserved      = T.reserved lexer
  91
+commaSep      = T.commaSep lexer
  92
+commaSep1     = T.commaSep1 lexer
  93
+semiSep       = T.semiSep lexer
20  test.conf
... ...
@@ -0,0 +1,20 @@
  1
+# Normal string.
  2
+error_log /var/log/nginx/error.log info;
  3
+
  4
+# Quoting is not needed.
  5
+error_log "/var/log/nginx/quoted.log" info;
  6
+
  7
+
  8
+# Regex is not needed.
  9
+location ~ ^/foo {
  10
+    root /excessive/regex;
  11
+}
  12
+
  13
+# Regex may be not needed (if user didn't want case insensitive matching)
  14
+location ~* ^/foo {
  15
+    root /maybe/excessive/regex;
  16
+}
  17
+
  18
+if (!-f $request_filename) {
  19
+    root /dont/use/if;
  20
+}

0 notes on commit 15d1db7

Please sign in to comment.
Something went wrong with that request. Please try again.